From: djmcgrath Date: Fri, 19 Oct 2007 05:28:55 +0000 (+0000) Subject: * Move rebranding branch to trunk X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=1c0a2202fe58159dd4d4197c4ff8b21f9387685e;hp=16c36ddd8e8e1f0c2e6add8e2ddc52005f5e7198;p=infobot.git * Move rebranding branch to trunk git-svn-id: https://svn.code.sf.net/p/infobot/code/trunk@1561 c11ca15a-4712-0410-83d8-924469b57eb5 --- diff --git a/AUTHORS b/AUTHORS new file mode 100644 index 0000000..65c82c2 --- /dev/null +++ b/AUTHORS @@ -0,0 +1,36 @@ +Infobot (rebranded blootbot): + License: Artistic + Main Author: + - Tim Rike + Other Contributors: + - David Sobon + - Danny Jabbour [GmLB] + - Danny McGrath + +Infobot (original): + License: As perl (GPL & Artistic) + - Kevin A. Lenzo [oznoid] + - Patrick Cole [ltd] + +Blootbot: + License: Artistic + Main Author: + - Tim Riker + Other Contributors: + - David Sobon + - Danny Jabbour [GmLB] + +Module-Reload: (idea taken) + License: Artistic + - Doug MacEachern + - Joshua Pritikin + +Module-Units: + License: GPL + - M-J. Dominus + +OnJoin: + - Corey Edwards + +Quotes file (files/infobot.randtext): + - ??? Ask netgod/larne/is for dpkg's tcl diff --git a/BUGS b/BUGS new file mode 100644 index 0000000..85389ce --- /dev/null +++ b/BUGS @@ -0,0 +1,11 @@ +Known bugs that should be dealt with soon as possible: + + * "+sed" can currently be used to flood the boot off the network. Disable for now + * allows adding a "cmd:foo (.*)" factoid but not removing it (not sure if this still applies) + * Older CMD: foo's cannot be used or removed. Must be removed manually from the database with SQL + * !+topic list gives and incorrect error Failed. "You (#botpark) are not in #botpark, hey?" + * Bot tries to ask chanserv for OP's on any channel. Should be a chanset setting on a per channel basis + * News is currently stored in a file rather than the SQL table created for it + * bot doesnt seem to keep track of stat counters for "heh :) ...etc". Might be settings though and not a bug + * !help has size issues. Add's extra lines with only 1 or 2 help commands instead of one maximum size IRC msg + * FIXME: !WARN! ircCheck: we have a NULL chan in hash channels? removing! diff --git a/ChangeLog b/ChangeLog new file mode 100644 index 0000000..e69de29 diff --git a/INSTALL b/INSTALL new file mode 100644 index 0000000..f006274 --- /dev/null +++ b/INSTALL @@ -0,0 +1,28 @@ +Method of installation. +----------------------- + +- Copy files/sample/* to files/ + +- Edit files/infobot.config, modify to taste. +- Edit files/infobot.servers to modify list of IRC servers to connect. +- Edit files/infobot.chan to set which channels to join. + +- Install the following Perl modules: + - Net::IRC perl module + - Debian: (apt-get install libnet-irc-perl) + - WWW::Search + - Debian: (apt-get install libwww-search-perl) + - LWP + - Debian: (apt-get install libwww-perl) + - HTML::Parser + - Debian: (apt-get install libhtml-parser-perl) + +- Choose your database: + - MySQL, read INSTALL.mysql (supported) + - SQLite, read INSTALL.sqlite (supported) + - SQLite2, read INSTALL.sqlite (supported) + - PgSQL, read INSTALL.pgsql (unsupported, may work) + +- There are "bugs" in the perl modules. Read INSTALL.patches on how to fix. + +- Finally, './infobot' diff --git a/INSTALL.mysql b/INSTALL.mysql new file mode 100644 index 0000000..f8d04bc --- /dev/null +++ b/INSTALL.mysql @@ -0,0 +1,39 @@ +INSTALL.mysql +---------------- + +- Install a MySQL server and the DBI Perl modules. + - Debian: (apt-get install mysql-server libdbd-mysql-perl) + +- Run 'mysqladmin -u root -p create ' + Where is the same as specified in infobot.config. + +- Run 'setup/setup.pl' + += Possible problems + - if connection to localhost is (short) refused, run + '/etc/init.d/mysql stop' + '/etc/init.d/mysql start' + - if connection for user is refused, reload grant tables with + 'mysqladmin -u root -p reload' + +* [OPTIONAL] + - run 'scripts/dbm2mysql.pl old-db' to convert dbm database file + to mysql. + +ADDITIONAL NOTES: +----------------- +You can add a new user manually by connecting to MySQL and performing these +commands: + + $ mysql -u root -p + + mysql> CREATE DATABASE infobot; + mysql> GRANT USAGE ON *.* TO 'user'@'localhost' IDENTIFIED BY 'yourpassword'; + mysql> GRANT ALL PRIVILEGES ON infobot.* TO 'user'@'localhost'; + +FULL FACTOID DATABASE: +---------------------- +You can get the data from the MySQL database that the apt bot uses on +#debian at freenode (irc.freenode.net), at: + + http://lain.cheme.cmu.edu/~apt/infobot/apt.sql.bz2 diff --git a/INSTALL.patches b/INSTALL.patches new file mode 100644 index 0000000..c72294c --- /dev/null +++ b/INSTALL.patches @@ -0,0 +1,16 @@ +INSTALL.patches +------------------- + +- apply *.patch patches inside patches/ + - cd /usr/lib/perl5/WWW/Search + patch -p0 < WWW::Search::Google.patch + +- alternatively, move the files from patches/ + - mv patches/Google.pm /usr/lib/perl5/WWW/Search/ + +Net::IRC DCC CHAT +---------------------- +Unfortunately, Net::IRC 0.70 has buggy code that does not detect DCC CHAT +properly. to patch: + cd /usr/share/perl5/Net/IRC/ + cat ~bot/patches/Net_IRC_Connection_pm.patch | patch -p0 diff --git a/INSTALL.pgsql b/INSTALL.pgsql new file mode 100644 index 0000000..03a3491 --- /dev/null +++ b/INSTALL.pgsql @@ -0,0 +1,39 @@ +Method of installation. +----------------------- + +- Debian: (apt-get install postgresql) +- Debian: (apt-get install libpg-perl) + + +As of now, infobot has full pgsql support. It seems to be working 100%, but it +assumes that you have precreated the database and user for now. As long as you +already created the database and user and stored this info in the +infobot.config, then the tables will automatically be created on startup. Until +I get setup.pl fixed, run the following commands as root (or postgres if root +doesnt have permission to create users/db's): + +> createuser --no-adduser --no-createdb --pwprompt --encrypted +> createdb --owner= [] + +Dont forget to replace and so forth with actual values you intend to use, +and dont include the <>'s ;) If you run these commands, you should get a user +with an encrypted password that cannot create new db's or user's (as it should +be!), and the user will own the newly created database . Congrats! + +If everything went fine, you should have everything infobot needs to use pgsql. +Next simply cd to the base directory you installed the bot to and type: + +./infobot + + +Thats it! Everything the bot needs should be automatically created when it loads +for the first time. + +In the future I will try to get around to editing the setup.pl file to ask the +same questions it does for mysql (your root password etc) so that you can skip +manually creating the database/user. But for now, this should be just fine for +most of you techies out there. + + +---- +troubled@freenode diff --git a/INSTALL.sqlite b/INSTALL.sqlite new file mode 100644 index 0000000..66c8425 --- /dev/null +++ b/INSTALL.sqlite @@ -0,0 +1,29 @@ +INSTALL.sqlite +---------------- + +SQLite is a C library that implements an embeddable SQL database engine. +Programs that link with the SQLite library can have SQL database access without +running a separate RDBMS process. The distribution comes with a standalone +command-line access program (sqlite) that can be used to administer an SQLite +database and which serves as an example of how to use the SQLite library. + +infobot will create a file called .sqlite and populate the tables for +you if they do not already exist. + +- Install SQLite libraries and DBI Perl modules. + - Debian: (apt-get install libsqlite0 libdbd-sqlite-perl) + +other distros might need to build from sources. + +You may use either DBD::SQLite or DBD::SQLite2 + +SQLite sources: + +http://www.hwaci.com/sw/sqlite/ + +DBD::SQLite sources: + +http://search.cpan.org/author/MSERGEANT/DBD-SQLite/ + +You will also need the normal Perl DBD stuff which should be included in your +Perl distribution. diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..5f22124 --- /dev/null +++ b/LICENSE @@ -0,0 +1,131 @@ + + + + + The "Artistic License" + + Preamble + +The intent of this document is to state the conditions under which a +Package may be copied, such that the Copyright Holder maintains some +semblance of artistic control over the development of the package, +while giving the users of the package the right to use and distribute +the Package in a more-or-less customary fashion, plus the right to make +reasonable modifications. + +Definitions: + + "Package" refers to the collection of files distributed by the + Copyright Holder, and derivatives of that collection of files + created through textual modification. + + "Standard Version" refers to such a Package if it has not been + modified, or has been modified in accordance with the wishes + of the Copyright Holder as specified below. + + "Copyright Holder" is whoever is named in the copyright or + copyrights for the package. + + "You" is you, if you're thinking about copying or distributing + this Package. + + "Reasonable copying fee" is whatever you can justify on the + basis of media cost, duplication charges, time of people involved, + and so on. (You will not be required to justify it to the + Copyright Holder, but only to the computing community at large + as a market that must bear the fee.) + + "Freely Available" means that no fee is charged for the item + itself, though there may be fees involved in handling the item. + It also means that recipients of the item may redistribute it + under the same conditions they received it. + +1. You may make and give away verbatim copies of the source form of the +Standard Version of this Package without restriction, provided that you +duplicate all of the original copyright notices and associated disclaimers. + +2. You may apply bug fixes, portability fixes and other modifications +derived from the Public Domain or from the Copyright Holder. A Package +modified in such a way shall still be considered the Standard Version. + +3. You may otherwise modify your copy of this Package in any way, provided +that you insert a prominent notice in each changed file stating how and +when you changed that file, and provided that you do at least ONE of the +following: + + a) place your modifications in the Public Domain or otherwise make them + Freely Available, such as by posting said modifications to Usenet or + an equivalent medium, or placing the modifications on a major archive + site such as uunet.uu.net, or by allowing the Copyright Holder to include + your modifications in the Standard Version of the Package. + + b) use the modified Package only within your corporation or organization. + + c) rename any non-standard executables so the names do not conflict + with standard executables, which must also be provided, and provide + a separate manual page for each non-standard executable that clearly + documents how it differs from the Standard Version. + + d) make other distribution arrangements with the Copyright Holder. + +4. You may distribute the programs of this Package in object code or +executable form, provided that you do at least ONE of the following: + + a) distribute a Standard Version of the executables and library files, + together with instructions (in the manual page or equivalent) on where + to get the Standard Version. + + b) accompany the distribution with the machine-readable source of + the Package with your modifications. + + c) give non-standard executables non-standard names, and clearly + document the differences in manual pages (or equivalent), together + with instructions on where to get the Standard Version. + + d) make other distribution arrangements with the Copyright Holder. + +5. You may charge a reasonable copying fee for any distribution of this +Package. You may charge any fee you choose for support of this +Package. You may not charge a fee for this Package itself. However, +you may distribute this Package in aggregate with other (possibly +commercial) programs as part of a larger (possibly commercial) software +distribution provided that you do not advertise this Package as a +product of your own. You may embed this Package's interpreter within +an executable of yours (by linking); this shall be construed as a mere +form of aggregation, provided that the complete Standard Version of the +interpreter is so embedded. + +6. The scripts and library files supplied as input to or produced as +output from the programs of this Package do not automatically fall +under the copyright of this Package, but belong to whoever generated +them, and may be sold commercially, and may be aggregated with this +Package. If such scripts or library files are aggregated with this +Package via the so-called "undump" or "unexec" methods of producing a +binary executable image, then distribution of such an image shall +neither be construed as a distribution of this Package nor shall it +fall under the restrictions of Paragraphs 3 and 4, provided that you do +not represent such an executable image as a Standard Version of this +Package. + +7. C subroutines (or comparably compiled subroutines in other +languages) supplied by you and linked into this Package in order to +emulate subroutines and variables of the language defined by this +Package shall not be considered part of this Package, but are the +equivalent of input as in Paragraph 6, provided these subroutines do +not change the language in any way that would cause it to fail the +regression tests for the language. + +8. Aggregation of this Package with a commercial distribution is always +permitted provided that the use of this Package is embedded; that is, +when no overt attempt is made to make this Package's interfaces visible +to the end user of the commercial distribution. Such use shall not be +construed as a distribution of this Package. + +9. The name of the Copyright Holder may not be used to endorse or promote +products derived from this software without specific prior written permission. + +10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR +IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED +WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. + + The End diff --git a/README b/README new file mode 100644 index 0000000..eb0f6fa --- /dev/null +++ b/README @@ -0,0 +1,160 @@ +infobot v1.5.0 +-------------- + +INTRODUCTION + This bot is based upon blootbot, which was a fork of infobot-0.44.2 by +Kevin Lenzo , which is now officially rebranded back to +infobot! The basis of infobot is still there but _many_ wild features have +been added. Along the way, a couple of typos were spotted in the original +infobot source and fixed in this version. Without infobot, there would be no +blootbot, and thus no infobot again, so all thanks to kevin for bringing +infobot in the first place. + + +FEATURES + * Additional information stored with factoids. (factinfo) + * Wide range of statistics for Bot, Factoids, IRC, Debian. + (status, factstats, ircstats, chanstats, cmdstats) + * Advanced topic management. (the first cool feature) + * Improved factoid search, allowing search by key or value. + * Freshmeat support (freshmeat.net) + * Debian Contents and Packages, search and info. + * ChanServ/NickServ (OPN) support. + * WWW-Search (eg: google for BLAH) + * Slashdot, Kernel and Freshmeat auto-update announcements. + * Units conversion (provided by external module, Units-Module) + + +DESIGN + - Modularity. Ability to disable IRC or Factoid support. + - Funky pseudo Module autoloader support + - Eleet Forker() function + + +IMPROVEMENTS + * log file is not opened and closed for each line of data + => unblocked logging is used. + * seen data is not flushed for each public message on IRC + => caching and flushing over an interval is used. + + +HISTORY + As of 0.99pre1, blootbot supports mysql database in the hope to +increase performance and to avoid borked over dbm's which occurred when +the bot crashed (??). The mysql code is far larger (or perhaps twice +as many functions) than expected even though a few functions were needed +for DBM due to lack of table deficiencies. + + As of 1.0.0pre1, blootbot takes advantage of Net::IRC. The +change over was fairly comfortable (95% clean). Just minor problems here +and there, mostly debugging and getting it right. + + As of 1.0.0RC2, the old style DBM (Berkeley) has been ported +back. It should work in all but 3 specific (countdown, factstats unreq) +cases. preliminary pgsql support has been added but someone with pgperl +knowledge needs to fix it up or at least unify the module with mysql. + + As of 1.5.0, blootbot was rebranded back to infobot. + + +INSTALLATION + - Read the included INSTALL file + + +NOTICE + Be warned that this bot consumes quite a lot of memory upon start +up and during usage. Right now, 7.4megs is used for old'ish perl, 8.3megs +with perl 5.005. fork() is used but don't be alarmed at the memory usage +as fork(), as I was told, uses COW (copy on write). + + WARNING: enabling wingate support may involve complaints of some +sort, probably because the telnet connection isn't closed properly. +However, these people do not realize the potential of open wingates. + + Please beta test it and report bugs as I have not had the time to +test all modifications properly (and extensively). Suggestions are +welcomed. + + gp@OPN is currently working on a C version of infobot or +blootbot, not based on the above source base. Core factoid code and +mysql support works - but that is it. + + +MODIFICATIONS + All modifications are that of the blootbot author unless otherwise +specified, like none. See 'ChangeLog' for details. A list of future +features listed in 'TODO'. + + See 'USAGE' for complete list of commands with description +(FIXME) and examples (FIXME). Yes, it is incomplete. It is better for +you to find the cookies than for me to hand-feed them to you ;) + + See 'EXAMPLES' for various usage of factoids and "hidden" +variables. If you're hardcore, check out 'CommandStubs.pl' and +'UserExtras.pl' for cool features. + + topic [help] - Topic help. + topic add - Append to the current topic. + topic del <#> - Purge topic ID <#> from current topic. + topic list - List broken down summary of current topic. + topic mod s/old/new/ - Modify the topic using regex. + - Now supports , and # as delimiters. + topic mv <1> <2> - : + before - Move <1> before <2> + after - Move <1> after <2> + swap - Swap <1> and <2> + topic shuffle - Jumble the subtopics. + + topic history - Show previous channel topics. + topic restore <#> - Restore channel topic to <#> on history + #list. + +==> Individual commands: NEW + (lobotomy|bequiet) -- [o] silence the bot. + (unlobotomy|benoisy) -- [o] unsilence the bot. + + set -- ... + unset -- ... + + +NOTES + To administrate/control the bot remotely, this can only be done +through DCC CHAT. /chat . All commands must be prepended by +'.' otherwise it is sent to the bot chat net + + +UNTESTED: + - user statistics shown by 'seen'. bug in this? + - User Information Services. + - new wingate caching/file-read code. + - disabling IRC/factoid support code. + - PG supports need to be worked and thoroughly tested. + + +CONTRIBUTIONS + jCommons, is, netgod, mu and Mercury for attempting to break my +modifications, aswell as giving suggestions and ideas in the early +development stages. Bashing of modifications courtesy of larne, irq, lilo +and \broken. + + mu@OPN for the SAR (=~ s///) and Topic history patch. + + someone emailed me a patch to fix up telnet but I accidently +deleted the message together with the patch after replying to the guy. I +hope to get that same guy to re-send me the patch... + + MbM@OPN sent a patch to clean up behaviour of factoids +(adding, removing, modifying). Thanks. + + +CONTACT + Contributions of a patch, or anything, can be sent to + + +Some Documentation is on the website. Please see it for details or +visit: http://infobot.sourceforge.net/ + + +IRC + If your looking to hang out on IRC, feel free. We can be found +in the #infobot channel on irc.freenode.net. See you there! diff --git a/README.quick b/README.quick new file mode 100644 index 0000000..c17c34d --- /dev/null +++ b/README.quick @@ -0,0 +1,14 @@ +See INSTALL file on how to install the bot. + +Quick usage instructions: +------------------------- + +DCC CHAT: +.+chan #chan +.chanset #chan +autojoin +.chanset +autojoin +.chanunset -autojoin +.chanset -autojoin + +for list of configuration options, run: + perl scripts/findparam.pl diff --git a/TODO b/TODO new file mode 100644 index 0000000..f76aa26 --- /dev/null +++ b/TODO @@ -0,0 +1,75 @@ +TODO: + - Normalize the SQL tables a little better to reduce size and increase speed + - Keep the Changelog, TODO and BUGS files up to date. Clean things up a bit + - rename ^[+-] commands + - remind - like this and others: http://jibble.org/reminderbot/ + - kill SHM and and move to a pipe + - add CIA like support - http://cia.navi.cx/ + - add pastebot like support - http://sial.org/pbot/ + - move nicks/server into sql table + - make channel flags be server/channel flags + - move channel flags to sql table, include initial state + - move praise from infobot.lang to "praise:" in factoids? + - move lart from infobot.lang to "lart:" in factoids? + - debian BTS frontend "bugs" + - !country + - !dinstall + - support DCC SEND of factoid (listkeys/listvals) that matched. + - news: show total requested count, users "registered", users + "ignored" + - add notes about news redesign to accomodate individual items + read - need to add id's to each item too. + - bind DCC CHAT service to port. + - man perlipc, search for service. + - do forking aswell. + - debian: "find -2.4.1" does not work but 2.4.1 does? + - $debug var needed. + - check if debian downloading files are proper. + - verbose: say why config option was enabled/enabled. + - registered flags for users/channels + - end of DynaConfig.pl + - use in UserDCC.. warn if value is not in list. + - add &checkSet() or &_chanset(); + - attempt to move userDCC to hooks. + - need to modify parseCmdHooks for user flags? + - make timers below 5 or 10 mins non-random values. + - create a .csv import/export program +-- EFFORT 1. + - make IRC/Schedulers.pl work 100%. + - intervals must be multiple of the smallest one otherwise + auto-fixed. + - make intervals chan-specific + - need to store info in $sched{$what}{$chan} = + time(); when last run or next run? + +Other TODO items may be listed on sourceforge. Please access it from the +website or this link: +http://sourceforge.net/pm/task.php?group_id=2241 + +---------------------------------------------------- +------------ FUTURE, NON-IMPORTANT + - ~country ua + - xk: add it :) and my imdb feature :) + - xk: and ~bugs :) + - "HACKING" text file, documentation of where things start, + what "core" or reuseable functions are used and what for. + - web interface + - on join message - customizeable, option. + - addon to UserInfo but for channels? + - ^B's are removed (HOW?) from factoids. + - asking questions.... make more guesses + - throttling of "help topic": push-pull system of &msg(). + - use autoloader properly. + - Module:::: + - make a global autoloader. + - support notification of author of deleted factoids, + - flag to hide owner of factoid. + - table data for DCC CHAT or misc table. + - dynamic user//configuration file upgrade: + - finer granuality(sp) of userlist/ignore file + - apt, find netconfig -- merge similar files. + - and same files(1 per package) for multiple packages. + - merge partial similar paths together. + - do some test cases to confirm code actually works as + proposed. + diff --git a/VERSION b/VERSION new file mode 100644 index 0000000..bc80560 --- /dev/null +++ b/VERSION @@ -0,0 +1 @@ +1.5.0 diff --git a/blootbot/AUTHORS b/blootbot/AUTHORS deleted file mode 100644 index 5efe778..0000000 --- a/blootbot/AUTHORS +++ /dev/null @@ -1,30 +0,0 @@ -Blootbot: - License: Artistic - Main Author: - - Tim Riker - Other Contributors: - - David Sobon - - Danny Jabbour [GmLB] - -Module-Reload: (idea taken) - License: Artistic - - Doug MacEachern - - Joshua Pritikin - -Module-Units: - License: GPL - - M-J. Dominus - -Infobot: - License: As perl (GPL & Artistic) - - Kevin A. Lenzo [oznoid] - - Patrick Cole [ltd] - -OnJoin: - - Corey Edwards - -Patches: - - ... - -Quotes file (files/blootbot.randtext): - - ??? Ask netgod/larne/is for dpkg's tcl diff --git a/blootbot/BUGS b/blootbot/BUGS deleted file mode 100644 index 85389ce..0000000 --- a/blootbot/BUGS +++ /dev/null @@ -1,11 +0,0 @@ -Known bugs that should be dealt with soon as possible: - - * "+sed" can currently be used to flood the boot off the network. Disable for now - * allows adding a "cmd:foo (.*)" factoid but not removing it (not sure if this still applies) - * Older CMD: foo's cannot be used or removed. Must be removed manually from the database with SQL - * !+topic list gives and incorrect error Failed. "You (#botpark) are not in #botpark, hey?" - * Bot tries to ask chanserv for OP's on any channel. Should be a chanset setting on a per channel basis - * News is currently stored in a file rather than the SQL table created for it - * bot doesnt seem to keep track of stat counters for "heh :) ...etc". Might be settings though and not a bug - * !help has size issues. Add's extra lines with only 1 or 2 help commands instead of one maximum size IRC msg - * FIXME: !WARN! ircCheck: we have a NULL chan in hash channels? removing! diff --git a/blootbot/ChangeLog b/blootbot/ChangeLog deleted file mode 100644 index 92811a2..0000000 --- a/blootbot/ChangeLog +++ /dev/null @@ -1,3340 +0,0 @@ -2007-03-13 troubled - - * files/sample/blootbot.chan: Change the #debian-bots channel to - #blootbot for publicity sake ;) - * TODO: Minor edits - * README: Mention IRC channel - * src/IRC/IrcHelpers.pl: Fixed bug in "+sed" that caused the bot - to flood itself off the network when passed large s///g;. A - temporary limit of 255 charaters on the output has been enabled. - -2007-03-11 22:00 troubled - - * src/{Process.pl,UserExtra.pl}: Fixed bug with karma stats. It - wasnt supplying the channel and causing a dupe pkey issue and - also resulted in global stats instead of per channel. Stats - are now per channel again. As a result, you should probably: - DELETE FROM stats WHERE channel = 'PRIVATE' AND "type" = 'karma'; - to clean up since they will never match now, or be pointless to - keep track of because karma can only be done in channel. - -2007-03-08 00:00 troubled - - * files/sample/blootbot.config: set tempDir changed to /tmp and - changed pgsql to SUPPORTED! - * src/dbi.pl: Fixed SQL comments (--) bug that prevented tables - from being created during startup. - * src/Modules/Factoids.pl: Typo for "factstats locked in selColHash - was preventing it from finding the func. Also addressed a !WARN! - issue about sorting a scalar. - * src/dbi.pl: Altered checkTables() to pass $dbtype when creating - tables. Table sql now called from setup/<$dbtype>/$table.sql - * src/Modules/Topic.pl: Fixed topicAuthor when no topic existed - and cleaned up original if statement to remove redundancy - * Reorganized the setup/ dir. Put schema SQL for each db type - into its own dir to allow customization. See the README file - * src/dbi.pl: Simplified the pgsql "SHOW TABLES" SQL - -2007-03-07 14:06 troubled - - * setup/pgsql/: Added pgsql specific dir. To be completed later - * setup/pgsql/pgsql-schema.sql: Import this file into an precreated - database as per blootbot.config and pgsql should be good to go - * INSTALL.pgsql: Changes to reflect semi-function pgsql progress - -2007-03-06 00:00 troubled - - * src/Process.pl: sqlReplace switched to sqlSet to fix pgsql. - sqlReplace should be removed since its not pg friendly. - There is no matching REPLACE INTO in pgsql. - * src/Factoids/DBCommon.pl: &setFactInfo during ~unlock set - time to NULL which Pgsql wants "0" since NOT NULL - * src/Factoids/Update.pl: see Process.pl change - * src/Misc.pl: see Process.pl change - * src/dbi.pl: Added working PostgreSQL support! yay! ;) - * src/Modules/botmail.pl: &sqlReplace -> &sqlSet; removed - &sqlQuote (data already quoted and broke 1 msg only) - * src/IRC/IrcHooks.pl: see Process.pl change - * src/IRC/Schedulers.pl: see Process.pl change - -2005-02-18 00:00 timriker - - * CMD: is now cmd: - -2005-02-18 00:00 timriker - - * src/Factoids/Question.pl: minVolunteerLength now per channel - * src/core.pl: getChanConf checks _default too - * src/: "s/hasParam/IsChanConfOrWarn/" - * src/: add handling for channel specific factoids: - "#botpark logs" -> http://ibot.rikers.org/botpark - factoidSearch is a space delimited list of prefixes to try - * src/: kill %myModules - loadMyModule expects the CORRECT CASE basename - * .: a ton of other crap that TimRiker never documented here - -2001-04-28 22:04 dms - - * src/IRC/: IrcHelpers.pl, IrcHooks.pl, Schedulers.pl: hookMode: - change chan to nick. if deopped by chanserv, check it dont change - channel limits during netsplit. - -2001-04-26 22:37 dms - - * src/: DynaConfig.pl, Process.pl, UserExtra.pl, core.pl, - Factoids/Statement.pl, IRC/Irc.pl, IRC/IrcHelpers.pl, - IRC/IrcHooks.pl, IRC/Schedulers.pl, Modules/News.pl: "~forget blah" - now works. thanks to ElectricElf documented user flags - public/private/notice send limit now configurable. thanks to EE - added "countrystats" command. - "blootbot: are you fixed now? :)" -- fixed. found by greycat - use hasParam instead of IsParam in UserExtra.pl/userCommands() - command "ord" handling fixed. - -2001-04-24 20:58 dms - - * src/: logger.pl, IRC/Irc.pl, IRC/IrcHelpers.pl, IRC/IrcHooks.pl, - IRC/Schedulers.pl: fix more warnings - set $ident in nick() - -2001-04-23 20:14 dms - - * src/: Process.pl, UserExtra.pl, logger.pl, IRC/Irc.pl, - IRC/IrcHooks.pl, IRC/Schedulers.pl: allow join to join irrelevent of being on chan - chanstats: count stats if exist - make perl happy - misc cleanup of status() - add time taken to join all channels, useless stats. - disable notify code - leakCheck: show stats on hash chanstats - mkBackup: show age of file. - -2001-04-22 22:58 dms - - * src/IRC/IrcHooks.pl: fix on_targettoofast once and for all, hopefully. - -2001-04-22 22:01 dms - - * src/: UserExtra.pl, logger.pl: make sure chanstats don't flood - don't throttle if it's a perl warn message - -2001-04-22 21:52 dms - - * src/Factoids/Reply.pl: woops... forgot this aswell - -2001-04-22 21:48 dms - - * src/Factoids/Reply.pl: disabled literal if factoid is requested via /msg by author; use literal - instead - -2001-04-22 20:25 dms - - * src/IRC/: Irc.pl, IrcHooks.pl, Schedulers.pl: don't call chanservcheck in joinnextchan - call chanservcheck in on_endofnames - ircCheck "resets" itself if it thinks so - -2001-04-22 20:17 dms - - * src/: Factoids/Question.pl, Factoids/Reply.pl, IRC/Irc.pl, - Modules/UserDCC.pl: part now warns if we're on a channel - allow it anyway. - added "reset" to DCC CHAT - -2001-04-21 22:37 dms - - * TODO: todo list, for those who want to know what "new" features will be coming - -2001-04-20 21:27 dms - - * src/: Process.pl, IRC/Schedulers.pl: we didn't set modified_time for deleted factoids - fixed - also... if final delete factoid list is >50... don't do it! - -2001-04-20 21:16 dms - - * src/: UserExtra.pl, IRC/Irc.pl: chagned notice lines/sec to 3 - made connectivity percentage 5 significant decimal places. - -2001-04-20 20:54 dms - - * src/: CommandStubs.pl, DynaConfig.pl, Misc.pl, Process.pl, - UserExtra.pl, Factoids/Question.pl, Factoids/Reply.pl, - Factoids/Statement.pl, IRC/Irc.pl, IRC/IrcHelpers.pl, - IRC/IrcHooks.pl, IRC/Schedulers.pl, Modules/Debian.pl, - Modules/DebianExtra.pl, Modules/Factoids.pl, Modules/Topic.pl, - Modules/Units.pl, Modules/Uptime.pl, Modules/UserDCC.pl: converted %{$blah{$blah}} to %{ $blah{$blah} } - added IRC hooks to catch failed channel joins - chanserv function moved to joinNextChan - created chanserv function for "common" use, chanServCheck - changed cache{chanlimitChange} hash a little - chanserv check removed from on_endofnames - typo on on_invite - fixed. - chanserv/ops removed from ircCheck() - joinNextChan removed from ircCheck() - added preliminary debian BTS frontend support - -2001-04-19 20:11 dms - - * src/Modules/News.pl: news: don't list new items if they don't have Text. - -2001-04-18 23:07 dms - - * src/: CommandStubs.pl, IRC/Irc.pl, IRC/IrcHooks.pl, - IRC/Schedulers.pl: fixed seen "" - added where debugging messages came from (functions) - fixed reversed use of % in if statement, stupid me :) - changed backup times for files again - -2001-04-18 22:51 dms - - * src/IRC/Irc.pl: forgot this one - -2001-04-18 22:50 dms - - * src/: UserExtra.pl, core.pl, IRC/Irc.pl, IRC/Schedulers.pl: added flood protection for notice() - added connectivity percentage to ircstats. - other changes forgotten - -2001-04-18 22:41 dms - - * src/IRC/IrcHooks.pl: fixed the following bugs: - [57419] on_ttf: X1 Target change too fast. Please wait 50 seconds. - [57604] !WARN! IsChanConf: lowercased chan. (Read error to - boren-[adsl-63-197-68-132.dsl.snfc21.pacbell.net]: EOF from client) - -2001-04-18 22:30 dms - - * src/: core.pl, IRC/IrcHelpers.pl, IRC/Schedulers.pl, - Modules/W3Search.pl: fix chanlimitChange time - w3search => "blah for blah" fails - fixed. - -2001-04-17 23:56 dms - - * src/IRC/IrcHelpers.pl: ok... use "" around hashes that use _ bare. - -2001-04-17 23:34 dms - - * src/: core.pl, Modules/News.pl: ... - -2001-04-17 22:03 dms - - * src/Modules/News.pl: forgot to use \d+ for read shortcut - other changes that the last commit missed or something - -2001-04-17 20:35 dms - - * src/core.pl: another round of useless changes - -2001-04-16 21:45 dms - - * src/: CommandStubs.pl, DynaConfig.pl, core.pl, IRC/Irc.pl, - IRC/IrcHooks.pl, IRC/Schedulers.pl, Modules/News.pl: chanset: fixed the following problem. - .chanset #debian +babeflish - .chanset #debian -babeflish - -chanunset #debian babelflish - - yet another minor bug, use !msgType for dcc chat aswell. - - selfflood proteciton for /msg - - like 4/sec or 1k/sec - - msgcount, msgbyte, msgtime - - pubcount, pubbyte, pubtime - - fixed other bugs.... weeeeeeee.... - -2001-04-14 22:48 dms - - * src/IRC/: IrcHelpers.pl, Schedulers.pl: prevent erratic (multiple) changes of chan limit in short space of time. - this would be a major problem in chanlimitVerify@IrcHelpers.pl since - it's called for every join. Better safe than sorry. - -2001-04-14 20:17 dms - - * src/: Process.pl, core.pl, IRC/Irc.pl, IRC/IrcHooks.pl, - IRC/Schedulers.pl, Modules/News.pl: IRC/IrcHooks.pl - - forgot to reset msgType/who/chan - after hookMsg in on_msg and on_public. - - on_join: if bot joins, don't do wingate/bans - and other useless stuff - - on_join: set msgType for ICC. - - on_part: set msgType/chan/who - - on_quit: set msgType/chan/who - - on_public: make chan global for ICC - => should fix all bugs. - => I have no idea how this worked so brokenly. - News.pl - more more changes - -2001-04-14 00:45 dms - - * src/: core.pl, IRC/IrcHelpers.pl, IRC/IrcHooks.pl, - IRC/Schedulers.pl, Modules/News.pl: another round of changes, damn it was hard to figure out why news wasn't - appearing properly - I think we still have that problem but it's semi - rare. - - Also fixed netsplit problems, forgot a next line. - - don't run all funky commands in on_join if netsplit is enabled. - - other tiny things not worth mentioning. - -2001-04-13 23:23 dms - - * src/: IRC/IrcHelpers.pl, IRC/IrcHooks.pl, IRC/Schedulers.pl, - Modules/Factoids.pl, Modules/News.pl: news: can make news compulsory (chanset +newsNotifyAll) - and opt-out (news unnotify) - irchooks: splitted into IrcHelpers.pl so we can reload it on the fly. - factoids: added debugging for short factoids that may be botched up - references - -2001-04-12 21:12 dms - - * src/: UserExtra.pl, db_mysql.pl, IRC/Schedulers.pl, - Modules/News.pl, Modules/UserDCC.pl: news: added news->factoid redirection - ton load of minor changes or bug fixes that cannot really be summarized - -2001-04-11 22:34 dms - - * src/: Process.pl, UserExtra.pl, db_mysql.pl, modules.pl, - IRC/IrcHooks.pl, IRC/Schedulers.pl, Modules/Debian.pl, - Modules/News.pl: A round of fixes: - - added dbReplace but it's broken - - debian infopackages shows dist - - news user cache now works properly - - "+" now works for all commands, not only for factoids - -2001-04-07 23:59 dms - - * src/Misc.pl: isStale is basically used by Debian.pl and we were using age in terms of - seconds but the actual function was assuming it was in days - fixed. - -2001-04-07 20:07 dms - - * src/: modules.pl, IRC/Schedulers.pl: - now backup news file just in case. - - Other changes we've not documented or small enough not to mention - -2001-04-07 20:07 dms - - * src/Modules/News.pl: - load file if we enabled option on the fly before re-run. - -2001-04-07 20:06 dms - - * src/CommandStubs.pl: - we now check if CODEREF exists. - -2001-04-07 20:06 dms - - * src/UserExtra.pl: - forgot Module for news. - -2001-04-07 20:05 dms - - * src/core.pl: - write opened files on shutdown/hup - -2001-04-06 22:05 dms - - * src/Modules/News.pl: When we did a symlink to all the set commands, the string was made - static (set to "Text") so it was broken. - also added link from Desc to Text - -2001-04-06 21:56 dms - - * src/Modules/News.pl: Just some more minor changes, to make some people happy, heh. - -2001-04-03 20:06 dms - - * src/: DynaConfig.pl, modules.pl, IRC/IrcHooks.pl, - IRC/Schedulers.pl, Modules/News.pl: More clean ups, forgotten what they were, heh. - -2001-04-01 23:25 dms - - * src/Modules/News.pl: forgot to add this file, heh. - -2001-04-01 23:16 dms - - * src/modules.pl: finally nailed this "random" bug noticed by asuffield. - -2001-04-01 23:00 dms - - * files/blootbot.help: added help for news - -2001-04-01 23:00 dms - - * src/: Misc.pl, IRC/IrcHooks.pl: Second round of News changes and bug fixes, kudos to greycat - -2001-03-31 22:19 dms - - * src/: CommandStubs.pl, DynaConfig.pl, Process.pl, UserExtra.pl, - core.pl, modules.pl, Factoids/Statement.pl, Factoids/Update.pl, - IRC/Irc.pl, IRC/IrcHooks.pl, IRC/Schedulers.pl, Modules/UserDCC.pl: Many changes, basically added and integrated News, and bug fixes. - Some more notes: - CommandStubs.pl - fixed "kernel blah" - Modules/UserDCC.pl - dont print $user when undefined. - modules.pl - added News.pl - Modules/News.pl - new feature. - Process.pl - "blootbot: ok is :)" -- FIXED. - -2001-02-28 20:17 dms - - * src/IRC/Irc.pl: removed msg/say repeating code. - -2001-02-28 20:17 dms - - * src/Process.pl: don't backup #DEL# factoids. asuffield. - -2001-02-28 20:17 dms - - * src/Factoids/Question.pl: fix for endless loop. asuffield. - -2001-02-28 20:12 dms - - * src/IRC/IrcHooks.pl: msgtime updated in on_msg - -2001-02-28 20:10 dms - - * src/IRC/Schedulers.pl: make dead-connect detection better. - -2001-02-23 20:26 dms - - * src/CommandStubs.pl: strip trailing whitespaces, force use of quotes to enable trailing - whitespace. requested by asuffield and \broken?. - -2001-02-23 20:25 dms - - * src/Process.pl: now use "or" instead of "and" operator for "rename". - -2001-02-23 20:24 dms - - * src/IRC/Irc.pl: closedcc debug - -2001-02-23 20:24 dms - - * src/IRC/Schedulers.pl: downlink check update? - -2001-02-20 21:01 dms - - * src/Factoids/Question.pl: - recursive factoid linking added. - -2001-02-20 21:01 dms - - * src/IRC/IrcHooks.pl: - lobotomy check in hookMsg - -2001-02-20 21:00 dms - - * src/Factoids/Update.pl: - reformatted totally - - added preliminary append-to-linked-factoid support. - - all return calls now return appropriately. - -2001-02-20 21:00 dms - - * src/: Misc.pl, UserExtra.pl: - added mkcrypt, fixed up "crypt" cmd. - -2001-02-20 20:59 dms - - * src/: CommandStubs.pl, core.pl, modules.pl: minor updates, warn fixes, removed comments - -2001-02-20 20:59 dms - - * src/IRC/Schedulers.pl: - lobotomy cache flush. - - disable uptime if not loaded. - - minor output update. - -2001-02-20 20:58 dms - - * src/Process.pl: - lobotomy warning now cached - - use &mkcrypt() - -2001-02-20 20:58 dms - - * src/DynaConfig.pl: - preliminary check of masks in chan for matches. - - ckpasswd, clean up. - -2001-02-20 20:58 dms - - * src/Modules/UserDCC.pl: - changed "m" to "n". asu. - - flush lobotomy cache on "unlobotomy" - - now use &mkcrypt() - -2001-02-17 21:42 dms - - * src/IRC/Schedulers.pl: - minor output update. - -2001-02-17 21:41 dms - - * src/UserExtra.pl: - removed '' from returns - - preliminary stats for on/off-line time - -2001-02-17 21:41 dms - - * src/Modules/UserDCC.pl: - ".op" fixed. found by Rev - - ".-ban" now removes the ban from the chan. - -2001-02-17 21:40 dms - - * src/IRC/Irc.pl: - sub "op" fixed. - - added sub "unban" - -2001-02-17 21:40 dms - - * src/IRC/IrcHooks.pl: - added first time run checks. - - on/off-line time stats - - on_join ban now kicks with custom reason. - -2001-02-17 21:40 dms - - * src/Factoids/Reply.pl: literal update - -2001-02-17 21:39 dms - - * src/Process.pl: - typo in if statement for "forget" when users - don't have +r flag. found by Rev - - added "pass" cmd. - - added "literal" factoid ask. - -2001-02-17 21:36 dms - - * src/core.pl: memusage support for open/free/net bsd added. patch from Kuma/Rev - -2001-02-13 23:50 dms - - * src/core.pl: update version of bot - -2001-02-13 23:47 dms - - * src/IRC/IrcHooks.pl: make nickserv work on more servers. requested by asuffield - -2001-02-13 23:35 dms - - * src/IRC/IrcHooks.pl: on-ban reason does not work... added debugging - -2001-02-13 23:28 dms - - * files/blootbot.help: updates from asuffield@OPN - -2001-02-13 23:18 dms - - * src/Modules/babel.pl: main:: fixes - -2001-02-13 23:04 dms - - * src/UserExtra.pl: - 'ascii' updates. - - hex now honours "allowConv" - - found by asuffield. - - redir of a redir fixed. - -2001-02-13 22:30 dms - - * src/IRC/IrcHooks.pl: added reason on ban. - -2001-02-13 22:18 dms - - * src/Process.pl: safe delete did not run delFactoid, hah! found by asuffield - -2001-02-13 22:07 dms - - * src/IRC/Irc.pl: ban fixes. - -2001-02-13 22:06 dms - - * src/Modules/UserDCC.pl: - moved read-only stuff from DynaConfig to here. - - added newpass - - .chpass didn't use arg[0] for user. - -2001-02-13 22:03 dms - - * src/DynaConfig.pl: - now prevent ".chanset +blah 10" - - recoded it a bit. - -2001-02-13 22:02 dms - - * src/IRC/IrcHooks.pl: - use "right way" to get keys from hash by checking if the hash ref - even exists... perl automatically "creates" this and causes problems - later on. (perldoc -f exists or defined) - - anti-repeat should not apply to /msg - - option to do kick on repeat... preliminary support. - - casing fixes to DCC CHAT. (reported by Revenge@OPN) - -2001-02-13 22:01 dms - - * src/IRC/Schedulers.pl: errors from Schedulers (chanlimitcheck) are cached and shown only once. - -2001-02-13 22:00 dms - - * src/Modules/Factoids.pl: - added support to factstats (requested,requesters) of "total" value. - -2001-02-13 21:59 dms - - * src/Modules/babel.pl: debugging added - -2001-02-13 21:58 dms - - * src/Misc.pl: added debian-specific debug to isStale - -2001-02-11 22:25 dms - - * src/: CommandStubs.pl, Misc.pl, modules.pl, IRC/Schedulers.pl, - Modules/Debian.pl: remaining stuff... should fix factoids problem I hope - -2001-02-10 00:47 dms - - * src/Modules/babel.pl: typo - -2001-02-10 00:29 dms - - * src/core.pl: slight change to ChanConfList to make schedulers work again - -2001-02-09 23:02 dms - - * src/: IRC/IrcHooks.pl, Process.pl: fixed up ignore code. discovered by debian@OPN - -2001-02-09 22:51 dms - - * src/IRC/Irc.pl: woops, use while instead of foreach for ircloop - -2001-02-09 22:48 dms - - * src/: Files.pl, core.pl: use static value for ircservers file - -2001-02-09 22:18 dms - - * src/core.pl: don't write user/chan file on HUP/restart. confirmed by asuffield - -2001-02-09 21:44 dms - - * src/Modules/UserDCC.pl: we did a sort() when we should not have for '.sched' - -2001-02-09 21:40 dms - - * src/CommandStubs.pl: changed FlatArg to ArrayArgs to make more sense. by default, we use flat-args - -2001-02-09 21:37 dms - - * src/IRC/IrcHooks.pl: forgot to set nuh for on_join; fixed up ban check on join. - -2001-02-09 21:23 dms - - * src/Process.pl: moved nick lock checking to lock only. detected by irq@OPN - -2001-02-09 21:18 dms - - * src/IRC/Irc.pl: added debugging info to ircloop... if irc() does not return ever, we'll have to take another approach to do connect-next-server-if-cant-connect - -2001-02-09 21:10 dms - - * src/UserExtra.pl: substitute the right vars in getReply when used in tell. found by asuffield - -2001-02-09 00:02 dms - - * src/IRC/IrcHooks.pl: this should fix ignores on global channels. found by 'debian'@OPN - -2001-02-08 23:51 dms - - * src/IRC/Schedulers.pl: divide by zero fix. thought I fixed it 2 weeks ago - -2001-02-08 23:50 dms - - * src/IRC/IrcHooks.pl: - pointless regex in on_dcc_chat_open that I was going to deal with on - failed WHOIS (nuh) lookups... now we just compare against "GETTING-NOW" - - on_quit debug info much cleaner now. - -2001-02-08 22:09 dms - - * src/CommandStubs.pl: we did not use flat args for forkers. found by asuffield. - -2001-02-08 22:00 dms - - * src/CommandStubs.pl: fix delayed task mechanism to verstats... we have to cache chan/nick/msgType. - -2001-02-08 21:57 dms - - * src/Shm.pl: possible fix for fork crashing and not detecting a crash from parent. warning included - -2001-02-08 21:52 dms - - * src/IRC/: IrcHooks.pl, Schedulers.pl: chan limit check code should now be disabled/re-enabled in relation to netsplits. discovered by asuffield - -2001-02-07 22:12 dms - - * src/Modules/UserDCC.pl: - list all schedulers and their respective time-of-next-run - -2001-02-07 22:11 dms - - * src/IRC/Schedulers.pl: - use CORE::system - -2001-02-07 22:11 dms - - * src/: Modules/Debian.pl, CommandStubs.pl: - finally (about three times) fixed search for "*bin*ssh*" for example, - kudos to bod@OPN - - also make searchDesc return list of packages and searchDescFE to output it. - - use searchDescFE - -2001-02-06 21:10 dms - - * src/Modules/Debian.pl: Fixed by swapping dists hash around. - -2001-02-06 20:42 dms - - * src/Modules/Debian.pl: debugging added. - -2001-02-06 20:42 dms - - * src/Modules/Topic.pl: ok from "topic -mod" => /msg only! - -2001-02-06 20:42 dms - - * src/IRC/Schedulers.pl: - added auto backup of user/chan files - - factoidCheck updates. - - nick-in-use timer update. - -2001-02-06 20:41 dms - - * src/: Process.pl, core.pl: - converted %joinverb to %cache - -2001-02-06 20:41 dms - - * src/UserExtra.pl: - added 'unique user count' to chanstats. - - wantnick updates - -2001-02-06 20:27 dms - - * src/IRC/IrcHooks.pl: - on_chat, forgot to set '$who' - - clean up aswell. - - converted %jointime to %cache - - we check limit on each on_join now. - -2001-02-06 20:23 dms - - * src/DynaConfig.pl: split off chanset from UserDCC to here to do multiple chans - - look at 1.19->1.20 to see changes - -2001-02-06 20:22 dms - - * src/Modules/UserDCC.pl: - Moved most of chanset to DynaConfig - - Should be able to do multiple chans now, like ".chanset #chan1 #chan2 - #chan3 +autojoin" - - if _default has option and ".chanunset #blah blah" or ".-chan #blah - blah", set vars on all other channels but remove on the channel - specific. - - if '.-chan blah' is done and does not exist on _default, remove - option from all channels. - - command to list which chans have option defined/set for. - - with respective values. - - ".chanset " - -2001-02-06 00:09 dms - - * src/Process.pl: final cruft from old static configuration file fixed... found by irq - -2001-02-06 00:04 dms - - * src/CommandStubs.pl: ok, that failed. lets now set $chan aswell - -2001-02-06 00:00 dms - - * src/CommandStubs.pl: verstats was using dynamic chan var... - -2001-02-05 23:45 dms - - * src/IRC/IrcHooks.pl: dont overwrite nuh{} if it already exists. - -2001-02-05 23:43 dms - - * src/Factoids/: Norm.pl, Question.pl: - remove front/rear whitespaces - - trailing symbols should work now. - -2001-02-05 23:30 dms - - * src/IRC/IrcHooks.pl: - endofnames: chanserv ops should work now. - - store topic irrevelent of setting. - - call ->whois() if nuh is not found. - -2001-02-05 23:29 dms - - * src/Modules/UserDCC.pl: - prevent dupe uses of ".+chan" - - when adding new chan, set autojoin. - -2001-02-05 23:29 dms - - * src/IRC/Schedulers.pl: - ircCheck => 120 interval. - - dccStatus now only shows chan info where the dcc chat user is on - _only_ - - added checking of %dcc hash for nuh hash checking. - -2001-02-05 22:32 dms - - * src/IRC/Schedulers.pl: defer leakCheck, increase interval. - -2001-02-05 22:31 dms - - * src/core.pl: comment out debugging - -2001-02-05 22:31 dms - - * src/IRC/IrcHooks.pl: - fixed when chan (msgType = private) is undefined. - -2001-02-04 20:23 dms - - * src/IRC/Irc.pl: reconnect if join fails - -2001-02-04 20:17 dms - - * src/IRC/Irc.pl: - output update - -2001-02-04 20:16 dms - - * src/IRC/IrcHooks.pl: - if in private, "is addressing" => "is /msg'ing". - - dccStatus fix ups. - - use ScheduleThis where possible. - -2001-02-04 20:14 dms - - * src/IRC/Schedulers.pl: typo for dccStatus fix :) - -2001-02-04 20:14 dms - - * src/Shm.pl: delForked: warn if name is source file. - -2001-02-04 20:13 dms - - * src/IRC/Schedulers.pl: - output update. - - prevent "unknown msg" for shm. - - typo for dcc hash. fixed. - - forgot about users,chops,bans define in dccStatus. fixed. - -2001-02-04 20:13 dms - - * src/CommandStubs.pl: if more than 1/4 users from channel gave version replies, verstats is active. - -2001-02-04 20:12 dms - - * src/core.pl: remove mem increase from DCC CHAT - annoying. - -2001-02-04 00:01 dms - - * src/: IRC/Schedulers.pl, Modules/Slashdot3.pl: more configuration crud and not-thinking-correctly design errors - -2001-02-03 23:51 dms - - * src/UserExtra.pl: added support for old Modules() for telling. - -2001-02-03 23:48 dms - - * src/Misc.pl: added IsParam back to hasParam together with isChanConf - -2001-02-03 23:33 dms - - * src/Factoids/Statement.pl: minor typo when fixing this before - -2001-02-03 23:21 dms - - * src/Modules/Debian.pl: validPackage or indirectly generateIndex should work now for the time being - -2001-02-03 23:09 dms - - * src/Modules/Debian.pl: woops forgot a few old config vars; converted to new format - -2001-02-03 23:06 dms - - * src/Modules/Debian.pl: converted to new gCCD - -2001-02-03 22:46 dms - - * src/Modules/UserDCC.pl: more fixups. - -2001-02-03 22:35 dms - - * src/Modules/UserDCC.pl: now use delete in place of undef - -2001-02-03 22:23 dms - - * src/IRC/IrcHooks.pl: looks like the final touches to fully exploit dynamic configuration have been made - -2001-02-03 22:10 dms - - * src/IRC/IrcHooks.pl: debugging info - -2001-02-03 22:06 dms - - * src/Process.pl: move identify code before outsider checking - -2001-02-03 22:03 dms - - * src/: IRC/Irc.pl, IRC/IrcHooks.pl, Misc.pl: - $nuh{} fix up. - - created on_dcc_open_chat for whois reply to get nuh. - - getRandomInt - allow decimal. - -2001-02-03 20:52 dms - - * src/: Shm.pl, IRC/Schedulers.pl: - time stamping added. - - dead/stale shm removal now works more intelligently. - However, older code will attempt to hijack and remove it anyway. - - check debian files with gzip -t. - - all schedulers should be deferred now. - -2001-02-03 20:51 dms - - * src/IRC/IrcHooks.pl: don't allow those without HOSTS in the user file to DCC CHAT. - -2001-02-03 20:51 dms - - * src/Modules/UserDCC.pl: fixed '.chanset' code. - -2001-02-03 20:50 dms - - * src/IRC/Irc.pl: added _default to chan mask. - -2001-02-02 22:03 dms - - * src/IRC/Schedulers.pl: I think this is the set of missed old->dynamic config changes that had to be done - -2001-02-02 22:03 dms - - * src/Modules/UserDCC.pl: compress config params as muc has possible per line - -2001-02-02 21:42 dms - - * src/core.pl: forgot to initialize counter for Moron - -2001-02-02 21:42 dms - - * src/Misc.pl: check if int is defined for fixPlural - -2001-02-02 21:38 dms - - * src/: DynaConfig.pl, Misc.pl, core.pl, modules.pl, - Factoids/Norm.pl, Factoids/Question.pl, Factoids/Reply.pl, - Factoids/Update.pl: tiny changes that I've missed - -2001-02-02 21:36 dms - - * src/IRC/: IrcHooks.pl, Schedulers.pl: temporary ignores can be removed automatically once expired - -2001-02-02 21:21 dms - - * src/Process.pl: typo for ckpasswd - -2001-02-02 21:12 dms - - * src/Shm.pl: - if shmRead fails, try openSHM. - -2001-02-02 21:12 dms - - * src/Process.pl: - fixup for question handling. - -2001-02-02 21:12 dms - - * src/UserExtra.pl: - tell: command redirection added. - -2001-02-02 21:12 dms - - * src/Modules/UserDCC.pl: - fix undefined for '.chanset' - - minor output update to '.bans' - -2001-02-02 21:11 dms - - * src/DynaConfig.pl: - undefining vars in wrong subs; fixed. - - fixes reading user/chan files finally, again. - -2001-02-02 21:10 dms - - * src/: CommandStubs.pl, Modules/babel.pl: - fixes for babelfish - - typo of IsChanConf for wwwsearch. - - parseCmdHooks return vals fixed. - - babel.pl: regex fixed -- works!!! - -2001-02-02 21:09 dms - - * src/: Modules/RootWarn.pl, Modules/Wingate.pl, IRC/Irc.pl, - IRC/IrcHooks.pl, IRC/Schedulers.pl: - more fixes to new-style config, should be 99% of it. - - convert IsParam() to IsChanConf() - - IRC/IrcHooks.pl: minor output update - - IRC/Schedulers.pl: - - minor update. - - make getChanConfDefault(PARAM,VALUE,CHAN) instead for convenience. - - temp ignore removal checking loop fixed. - -2001-02-01 22:21 dms - - * src/core.pl: - write user/chan file in 'shutdown' - -2001-02-01 22:18 dms - - * src/Modules/UserDCC.pl: - wrong order in .+ignore - - ".chanset #chan" fixup. - -2001-02-01 22:17 dms - - * src/IRC/Irc.pl: - getJoinChans, don't add _default - - joinNextChan() - check nickServ_pass - -2001-02-01 22:15 dms - - * src/DynaConfig.pl: - prevent /^[+-]/ options being loaded. - - ignore/ban lists now saved properly. - - forgot about \+ :-) - - verifyUser does caching now! - -2001-02-01 22:13 dms - - * src/IRC/Schedulers.pl: - SC for uptimeCycle - - renamed *Cycle to *Loop - -2001-02-01 22:11 dms - - * src/IRC/IrcHooks.pl: - minor output (debug) removed. - - new config conversion for rootWarn - -2001-02-01 22:06 dms - - * src/Process.pl: now use pass auth for 'identify'. - -2001-02-01 22:05 dms - - * src/Modules/Debian.pl: regex support for 'query' in &searchDesc() - -2001-01-31 22:53 dms - - * src/CommandStubs.pl: nickometer: there could be multiple results with the same version - percentage - fixed. Also don't merge same percentages together like in - other list (formListReply) statements. - -2001-01-31 22:31 dms - - * src/CommandStubs.pl: nickometer and verstats: sort descendingly - nickometer: fix undefined warning - -2001-01-31 21:31 dms - - * src/Modules/Debian.pl: make $refresh global in this file... removed all duplicates of getting - debianRefreshInterval config var. - -2001-01-31 21:28 dms - - * src/IRC/: Irc.pl, IrcHooks.pl: make $nickserv global and set to zero in Irc.pl - -2001-01-31 21:26 dms - - * src/Misc.pl: check if $age is NULL in &isStale() - -2001-01-31 21:18 dms - - * src/core.pl: &ChanConfList() typos - -2001-01-31 21:18 dms - - * src/Process.pl: added 'identify [nick]' - -2001-01-31 21:18 dms - - * src/IRC/Irc.pl: added retval to &ban() - -2001-01-31 21:17 dms - - * src/Modules/UserDCC.pl: minor fix for ignoreAdd() - -2001-01-31 21:17 dms - - * src/DynaConfig.pl: prevent repetion in verifyUser. - -2001-01-31 21:17 dms - - * src/Modules/Freshmeat.pl: - now use gCCD - -2001-01-31 21:17 dms - - * src/IRC/IrcHooks.pl: - ignore code cleaned up. - - ban on join added. - - added 'b' to &hookMode()'s stats keeping. - -2001-01-31 21:16 dms - - * src/IRC/Schedulers.pl: - forgot about interval for floodCycle. - - added nuh{} check to &leakCheck() - - added chanserv checking to &ircCheck() - -2001-01-30 21:19 dms - - * src/Modules/Debian.pl: support for new dynamic configuration infrastructure - -2001-01-30 20:47 dms - - * src/IRC/Schedulers.pl: - typo for already-run check. should work now. - -2001-01-30 20:46 dms - - * src/Modules/UserDCC.pl: - added '.sched' - -2001-01-30 20:46 dms - - * src/Misc.pl: - pSReply hack for &help(). - -2001-01-30 20:46 dms - - * src/Process.pl: - typo for return val of &Modules() - -2001-01-30 20:46 dms - - * src/DynaConfig.pl: - added removal of possible duplicate configuration entries when bot - exits. - -2001-01-30 20:45 dms - - * src/: Shm.pl, core.pl, modules.pl, Modules/Uptime.pl: - minor update (output and redundant vars) - -2001-01-30 20:44 dms - - * src/IRC/IrcHooks.pl: prevent dupes in verstats collection. - -2001-01-30 20:44 dms - - * src/CommandStubs.pl: - added 'unknown/cloaked' stats item to verstats. - - nickometer chan code cleanup. - -2001-01-29 23:04 dms - - * src/CommandStubs.pl: added 'verstats' - -2001-01-29 23:03 dms - - * src/Misc.pl: - strip ^chars update. - -2001-01-29 23:03 dms - - * src/IRC/Schedulers.pl: - fixed undefined stuff. - - put return's in wrong position; fixed. - -2001-01-28 22:34 dms - - * src/core.pl: removed obsoleted old dyn code - -2001-01-28 22:03 dms - - * files/sample/sample.config.proposed: - obsoleted... why was it even added in the first place. - -2001-01-28 22:02 dms - - * ChangeLog, ChangeLog.old: - finally generated ChangeLog from CVS - - moved old changelog to ChangeLog.old - -2001-01-28 22:00 dms - - * patches/: Connection.pm, Net::IRC.patch: - removed obsoleted files: it's now done in the bot code. - -2001-01-28 21:35 dms - - * files/: infobot.help, infobot.ignore, infobot.lang, infobot.lart, - infobot.randtext, infobot.users, sample.config, sample.countdown, - sample.insert: - obsoleted files removed - -2001-01-28 21:32 dms - - * src/: Misc.pl, Process.pl, Shm.pl, db_mysql.pl, - Factoids/Question.pl, Factoids/Reply.pl, Factoids/Statement.pl, - Factoids/Update.pl, IRC/Irc.pl, Modules/Debian.pl, - Modules/DebianExtra.pl, Modules/Dict.pl, Modules/Factoids.pl, - Modules/Freshmeat.pl, Modules/Kernel.pl, Modules/Quote.pl, - Modules/Search.pl, Modules/Slashdot3.pl, Modules/Topic.pl, - Modules/Units.pl, Modules/Uptime.pl, Modules/W3Search.pl, - Modules/Wingate.pl, Modules/babel.pl, Modules/insult.pl, - Modules/nickometer.pl: - Remaining files that were changed due to removal of $noreply or - indirectly caused by the change over to dynamic configuration - -2001-01-28 21:15 dms - - * src/IRC/Schedulers.pl: - added dccStatus - -2001-01-28 21:14 dms - - * src/UserExtra.pl: - if - is used before -about, don't tell us about what was told. - - ignorelist removed. - -2001-01-28 21:14 dms - - * src/modules.pl: - if core moduels fail to load, exit out properly. - -2001-01-28 21:14 dms - - * files/blootbot.help: - removed FIXME entries. - - added several new entries for UserDCC. still incomplete. - -2001-01-28 21:13 dms - - * files/blootbot.ignore: -REMOVED - -2001-01-28 21:12 dms - - * src/IRC/IrcHooks.pl: - when someone attempts dcc chat, if verbosity > 1, - show all info regarding that person. - -2001-01-28 21:12 dms - - * src/logger.pl: pre-config fix. - -2001-01-28 21:11 dms - - * src/Modules/UserDCC.pl: - added frontend to dynamic user/chan. - - - remove 99% of $noreply. WORKS - - change 'main::' to '::' WORKS - - - ".set" and ".unset" obsoleted. WORKS - - ".save" WORKS - - ".chanset #chan +bool" WORKS - - ".chanset #chan -bool" WORKS - - ".chanset #chan" WORKS - - ".chanunset #chan" WORKS - - ".chanunset #chan WHAT" WORKS - - ".chpass [pass]" WORKS - - ".chattr [user] +flag-flag" WORKS - - ".chnick [user] [new-user]" WORKS - - ".+host [user] [new mask]" WORKS - - ".-host [user] [del mask]" WORKS - - ".+ban [mask] [chan] [time] [reason]" WORKS - - ".-ban [mask]" WORKS - - ".whois [user]" WORKS - - ".bans [chan]" (BOT) WORKS - - ".banlist" (CHAN) DONE,TODO - - ".+ignore [#channel] [time] " WORKS - - ".-ignore " WORKS - - ".ignore [chan]" WORKS, - - ".adduser " DONE,TODO - - ".deluser " DONE,TODO - - ".+user " WORKS - - ".-user " WORKS - - ".chatset [channel] " DONE - - ".+chan <#chan>" WORKS - - ".-chan <#chan>" WORKS - - ".chaninfo" WORKS - -2001-01-28 21:08 dms - - * files/sample/: sample.chan, sample.config, sample.config.example, - sample.config.proposed, sample.countdown, sample.insert, - sample.users: - new directory for sample configuration - -2001-01-28 21:04 dms - - * files/: blootbot.chan, blootbot.users: - NEW style config file. - -2001-01-28 21:02 dms - - * src/core.pl: - NEW dynamic user/chan stuff. - - prevent doExit running twice. - - loadMyModulesNow after chanfile! - - added IsChanConf() and getChanConfList - -2001-01-28 21:00 dms - - * src/DynaConfig.pl: - NEW dynamic user/chan stuff. - -2001-01-28 20:50 dms - - * src/: User.pl, UserFile.pl: - REMOVED FILES. - -2001-01-28 20:50 dms - - * src/Files.pl: - removed userfile code. - - removed ignore code. - -2001-01-28 20:49 dms - - * src/CommandStubs.pl: - aCH: don't remake hook hash. - - pCH: warn if multiple matches are found. - - added nickometer for channel. - -2001-01-18 21:46 dms - - * src/Modules/Debian.pl: ca.d.o does not do non-US any more - -2001-01-17 20:22 dms - - * src/Modules/Factoids.pl: used \* instead of / for days, founded by fooz - -2001-01-15 21:11 dms - - * src/Factoids/Update.pl: added checking of NULL rhs just in case. - -2001-01-15 21:10 dms - - * src/Modules/Factoids.pl: - fix for null factoids in factinfo. - - added 'factstats nullfactoids'. - -2001-01-14 21:04 dms - - * src/Modules/Topic.pl: topic info now includes length - -2001-01-10 22:57 dms - - * src/IRC/Irc.pl: - cosmetic (useless) update. - -2001-01-10 22:56 dms - - * src/UserExtra.pl: - update to 'cpustats'. - -2001-01-10 22:55 dms - - * src/Misc.pl: - forgot [] around gettimeofday. - - select() added before first fork msg. - -2001-01-10 22:55 dms - - * src/Shm.pl: - minor mods to addForked wrt time. - - proper detection of dead forks. - -2001-01-10 22:54 dms - - * src/Modules/Debian.pl: quote typo@18,default==unstable - -2001-01-10 22:54 dms - - * src/modules.pl: - AUTOLOAD to ignore __ - - use eval on 'require'. - -2001-01-06 20:55 dms - - * src/Factoids/Reply.pl: - added smart_replace, finally fixed SARs for sure. - still need to move numeric range replacement into the loop. - -2001-01-06 20:54 dms - - * src/: Net.pl, Modules/Debian.pl, Modules/Factoids.pl, - Modules/Freshmeat.pl, Modules/Search.pl: - new time delta function - - Debian.pl: \Q\E in validPackage - -2001-01-06 20:53 dms - - * src/IRC/Irc.pl: clearIRCVars update - -2001-01-06 20:53 dms - - * src/modules.pl: DNS.pl removed. - -2001-01-06 20:52 dms - - * src/Modules/DNS.pl: Removed this file. - -2001-01-06 20:52 dms - - * src/: CommandStubs.pl, UserExtra.pl: - more updates. - - UserExtra.pl: added cpustats - - CommandStubs: added UserFlag support - -2001-01-06 20:51 dms - - * src/: Misc.pl, Shm.pl, IRC/IrcHooks.pl: - forker (POSIX::_exit) fixes. - - Misc.pl: added timedelta(renamed from gettimeofday),timeget. - -2001-01-03 21:44 dms - - * src/Net.pl: - &system typo. - -2001-01-03 21:43 dms - - * src/modules.pl: - DESTROY code removed. - -2001-01-03 21:42 dms - - * src/Misc.pl: - topic minor fix. - - POSIX::_exit(0) added: fixes fork problem. - -2001-01-03 21:42 dms - - * src/Factoids/Update.pl: - allow SARing of factoids on _long_ factoids providing the new string - is shorter than the subst string. - -2001-01-03 21:37 dms - - * files/blootbot.lang: - moron reply added. - -2001-01-03 21:37 dms - - * src/Factoids/Reply.pl: - Finally added proper recursive SARs - -2001-01-03 21:36 dms - - * src/Modules/Factoids.pl: - add 'days' to created_time output. - -2001-01-03 21:35 dms - - * src/Modules/Debian.pl: - "testing" changes (broken) - - make search packages case insensitive. - - non-US fixed... about time. - -2001-01-03 21:34 dms - - * src/Process.pl: - unified hook changes. - - ignore >64 questions. - - support moron language. - -2001-01-03 21:33 dms - - * src/UserExtra.pl: - start using hooks. - - added moron counter to 'status'. - -2001-01-03 21:32 dms - - * src/CommandStubs.pl: - unified for global command hooks - -2001-01-03 21:31 dms - - * src/IRC/: Irc.pl, IrcHooks.pl: - floodjoinCheck. - - note on endofmotd. - - Moved ircstats from Irc.pl to on_endofmotd#IrcHooks.pl - -2000-12-29 22:46 dms - - * src/Process.pl: for join, ignore whether on a channel if we have power - -2000-12-29 22:05 dms - - * src/IRC/IrcHooks.pl: lowercase chan in on_kick, found by xsdg! - -2000-12-19 21:06 dms - - * src/Factoids/Reply.pl: forgot about int() in randnick - found by lunartear - -2000-12-18 21:40 dms - - * src/core.pl: debug to restart - -2000-12-18 21:38 dms - - * src/Net.pl: Remove &ERROR() since it's done by WARN. - -2000-12-18 21:35 dms - - * src/Modules/Debian.pl: stop searching if found>100 - -2000-12-18 21:33 dms - - * src/Process.pl: ignore long unparseable messages. - -2000-12-16 20:32 dms - - * src/core.pl: hrm - -2000-12-16 20:31 dms - - * src/modules.pl: minor fix to loadmymodules - -2000-12-16 20:31 dms - - * LICENSE: - new file for license. - -2000-12-16 20:30 dms - - * src/Files.pl: userlist display now verbosity>1 - -2000-12-16 20:30 dms - - * src/IRC/IrcHooks.pl: - use dccsay - - show flags on dcc chat connection. - - set type on on_dcc* - -2000-12-16 20:29 dms - - * src/IRC/Irc.pl: - &dccsay() added. - - &dcc_close() added. - - use dccsay in performStrictReply() - -2000-12-15 23:36 dms - - * src/Misc.pl: very nice typo for regex, Angel indirectly found this :) - -2000-12-15 22:39 dms - - * src/User.pl: forgot to reset userHandle - -2000-12-15 22:28 dms - - * src/core.pl: forgot about / in tempDir - -2000-12-15 22:25 dms - - * src/Modules/UserDCC.pl: added '.mode' for Netsnipe - -2000-12-12 23:12 dms - - * src/core.pl: change ~ to ENV{HOME} - -2000-12-11 20:26 dms - - * src/IRC/Schedulers.pl: chanlimitcheck: removed netsplit check - -2000-12-11 20:24 dms - - * src/IRC/IrcHooks.pl: netsplit timer added - -2000-12-10 20:55 dms - - * src/Shm.pl: &showProc in delForked() - -2000-12-10 20:54 dms - - * src/IRC/IrcHooks.pl: userHandle now global var - -2000-12-10 20:53 dms - - * src/User.pl: verifyUser finally fixed - -2000-12-10 20:52 dms - - * src/core.pl: tempdir fix - -2000-12-10 20:51 dms - - * src/Modules/: Freshmeat.pl, Kernel.pl, Slashdot3.pl: temp dir unified - -2000-12-10 20:49 dms - - * src/Modules/Debian.pl: - 'find *bin*ssh*' should work. - - temp dir unified. - -2000-12-10 20:48 dms - - * src/Modules/Factoids.pl: - 'seefix' checks for self-redirects and removes if successful. - - 'deadredir' reject long vals. - - 'listfix' added. - -2000-12-09 21:26 dms - - * src/Modules/Topic.pl: removed/convert debug messages - -2000-12-09 21:04 dms - - * src/IRC/IrcHooks.pl: changed debug to status line - -2000-12-09 21:01 dms - - * src/IRC/Schedulers.pl: forgot to return for limitcheck + netsplit - -2000-12-08 21:09 dms - - * src/IRC/Schedulers.pl: renamed limitCheck to chanlimitCheck - -2000-12-04 21:31 dms - - * src/IRC/Schedulers.pl: Typos galore for logCycle, should be fixed - -2000-12-03 21:52 dms - - * src/IRC/Schedulers.pl: output cleanup - -2000-12-03 21:51 dms - - * src/Modules/Debian.pl: fallback on * properly - -2000-12-03 21:50 dms - - * src/Modules/W3Search.pl: Moved w3 regex here - -2000-12-03 21:48 dms - - * src/CommandStubs.pl: typo fixed - -2000-12-03 21:47 dms - - * src/CommandStubs.pl: Removed W3 regex - -2000-12-03 21:46 dms - - * src/Modules/Factoids.pl: Added 'factstats seefix' - -2000-12-03 21:46 dms - - * src/Misc.pl: validFactoid. - -2000-11-24 22:26 dms - - * src/Modules/Debian.pl: Contents for non-US is broken! - -2000-11-24 22:02 dms - - * src/Modules/Debian.pl: typo - -2000-11-24 20:23 dms - - * src/Misc.pl: - validFactoid. - - fixString - -2000-11-24 20:17 dms - - * src/Modules/Freshmeat.pl: - prevent dupe errors. - - support bz2/gz for appindex. - -2000-11-24 20:10 dms - - * src/Shm.pl: if name undefined, bail out - -2000-11-24 20:07 dms - - * src/modules.pl: use modulebase instead of modulefile for delForked() - -2000-11-23 23:10 dms - - * src/CommandStubs.pl: made freshmeat fork always - -2000-11-23 22:53 dms - - * src/Modules/Freshmeat.pl: changed core to www - -2000-11-23 22:22 dms - - * src/CommandStubs.pl: @args changed to flat - -2000-11-23 22:21 dms - - * src/: Misc.pl, Net.pl: debug messages removed - -2000-11-23 22:21 dms - - * src/Modules/Debian.pl: more cleanups. ^blah and blah$ workspico Debian.pl! - -2000-11-19 22:56 dms - - * src/Modules/Debian.pl: debug - -2000-11-19 22:56 dms - - * src/modules.pl: use AUTOLOAD to prevent crashes - -2000-11-19 22:55 dms - - * src/Net.pl: Reduced timeout by 10x - -2000-11-19 22:54 dms - - * src/UserExtra.pl: Fixed up tell to allow target == 'us'. - -2000-11-19 22:49 dms - - * src/IRC/IrcHooks.pl: Exit process if on_public hook is activated under fork - -2000-11-01 21:59 dms - - * src/UserExtra.pl: - fixed up tell. - - 'cycle' changed a bit. - -2000-11-01 21:55 dms - - * src/IRC/Irc.pl: debug msg for mixed-case chan - -2000-11-01 21:54 dms - - * src/IRC/Schedulers.pl: - make sure we reschedule everything unless it's a non-recoverable error. - - disable limit if split active in limitcheck. - - enabled 'unlink' in logcycle. - -2000-10-04 00:08 dms - - * src/CommandStubs.pl: - we shifted args before using args[0]. fixed. - - fixed broken 'convert' cmd. - -2000-10-03 01:33 dms - - * src/core.pl: version update - -2000-10-03 01:29 dms - - * src/modules.pl: minor change to reloadModule - -2000-10-03 01:26 dms - - * src/db_mysql.pl: added sth->finish in an attempt to prevent leaks - -2000-10-03 01:26 dms - - * src/CommandStubs.pl: alias to fm for freshmeat forgotten - -2000-10-03 01:23 dms - - * src/db_dbm.pl: minor update - -2000-10-03 01:20 dms - - * src/Modules/Freshmeat.pl: cleanup of comments - -2000-10-03 01:19 dms - - * src/IRC/Irc.pl: change timeout value for scheduler interval - -2000-10-03 01:12 dms - - * src/IRC/IrcHooks.pl: fixed - typo for join() - -2000-09-29 23:39 dms - - * src/CommandStubs.pl: tiny cleanup - -2000-09-29 23:10 dms - - * src/Modules/UserDCC.pl: Minor cleanup - -2000-09-29 23:03 dms - - * src/IRC/IrcHooks.pl: DCC fixed - -2000-09-25 20:08 dms - - * src/IRC/Irc.pl: fixed up performReply to be more intelligent - when doing random stuff. - -2000-09-25 20:07 dms - - * src/Factoids/Question.pl: notfound uses @query now; removed origQuery - -2000-09-25 00:20 dms - - * src/logger.pl: close log then statuspico logger.pl! - -2000-09-24 19:53 dms - - * src/CommandStubs.pl: more changes - -2000-09-24 19:51 dms - - * src/Modules/Dict.pl: moved a few lines from CommandStubs.pl here - -2000-09-24 19:50 dms - - * src/Factoids/Question.pl: added 'debianForFactoid'. - fixed question 'you suck'. found by cerb. - -2000-09-24 19:49 dms - - * src/core.pl: forgot 'next' in dir check - -2000-09-23 22:18 dms - - * scripts/setup_sql.pl: closed 114944 -- karma can't be a negative int - -2000-09-23 22:15 dms - - * src/core.pl: added check for dirs on startup - -2000-09-23 22:12 dms - - * src/Modules/Slashdot3.pl: moved temp dir check to core.pl - -2000-09-23 20:46 dms - - * src/Modules/Freshmeat.pl: removed some debug lines - -2000-09-23 20:45 dms - - * src/modules.pl: fixed up return vals for loadMyModule() - -2000-09-23 20:45 dms - - * src/Modules/RootWarn.pl: non-mysql stub - -2000-09-23 20:44 dms - - * src/CommandStubs.pl: more conversion to new code - -2000-09-23 20:43 dms - - * src/IRC/Schedulers.pl: one too many parens for seen stats; cleanup. - -2000-09-23 20:30 dms - - * src/logger.pl: repeat throttling added - -2000-09-22 19:56 dms - - * src/Modules/Debian.pl: minor update - -2000-09-22 19:56 dms - - * src/CommandStubs.pl: moved more functions to new hook scheme - -2000-09-22 19:55 dms - - * src/Shm.pl: forgot shmFlush() in closeSHM() - -2000-09-22 18:51 dms - - * files/sample.config: 'undelete' option - -2000-09-22 18:50 dms - - * src/IRC/Schedulers.pl: periodically check to delete deleted factoids - -2000-09-22 18:49 dms - - * src/Process.pl: added undelete command - -2000-09-22 18:49 dms - - * src/Files.pl: removed some verbosity. - -2000-09-22 18:48 dms - - * src/modules.pl: verbose on reload (time ago, delta time) - -2000-09-18 21:37 dms - - * src/IRC/Irc.pl: op (mode) does not work? - -2000-09-18 20:01 dms - - * src/Modules/Debian.pl: typo for searchDesc list element - -2000-09-18 19:47 dms - - * src/Misc.pl: minor text cleanup. - removed checkPing. - -2000-09-18 19:47 dms - - * src/CommandStubs.pl: minor cleanup. - Preliminary command hooks (event handlers) working! - -2000-09-18 19:46 dms - - * src/IRC/Schedulers.pl: Chanserv 2nd stage fail protection - Added seen stats. - -2000-09-18 19:45 dms - - * src/Modules/Debian.pl: Added NULL check for &search*(); - Added stubs for archived revisions. - -2000-09-18 19:44 dms - - * src/Factoids/Question.pl: Trailing symbols (.!) ignored on question - Founded by Flugh - -2000-09-18 19:43 dms - - * src/db_mysql.pl: sqldebug clean up; forgot a return line for GetCol - -2000-09-18 19:37 dms - - * src/IRC/Irc.pl: chanserv update to &joinNextChan() - -2000-09-18 19:36 dms - - * src/IRC/IrcHooks.pl: minor update - -2000-09-18 19:34 dms - - * src/User.pl: removed repetitive debug line - -2000-09-18 19:30 dms - - * src/Process.pl: removed feedback addressing. Issue raised by Flugh - -2000-09-16 22:12 dms - - * src/CommandStubs.pl: added ddesc for desc search - -2000-09-16 22:11 dms - - * src/Modules/Debian.pl: added &searchDesc() if &searchContents() fails - -2000-09-16 22:10 dms - - * src/IRC/Schedulers.pl: added NULL irc channel check - -2000-09-16 22:09 dms - - * src/core.pl: removed loggingstatus - -2000-09-16 21:57 dms - - * src/logger.pl: &status() changes. removed loggingstatus in favour of fileno(). - -2000-09-16 21:23 dms - - * scripts/setup_sql.pl: another attempt for a fix - -2000-09-14 21:29 dms - - * scripts/: setup_sql.pl, setup_tables.pl, setup_users.pl: script merge, doc update - -2000-09-14 20:13 dms - - * src/: Files.pl, UserFile.pl, Modules/UserDCC.pl: status() -> &status() - -2000-09-14 20:12 dms - - * src/IRC/IrcHooks.pl: minor text fixup for umode - -2000-09-14 20:11 dms - - * src/IRC/Schedulers.pl: Added miscCheck(), now does reloadAllModules() - -2000-09-14 20:07 dms - - * src/modules.pl: ability to reload extra modules automatically - -2000-09-14 00:39 dms - - * src/Modules/Debian.pl: another installed-size prob fix - -2000-09-13 22:18 dms - - * src/Factoids/Reply.pl: Removed FIXME - -2000-09-13 22:07 dms - - * src/Misc.pl: stat used wrong time, [8] instead of [9] - -2000-09-13 22:03 dms - - * src/Misc.pl: changed some text, more debugging - -2000-09-13 22:02 dms - - * src/Modules/Debian.pl: hopefully last time it will be fixed - -2000-09-13 21:39 dms - - * src/Modules/Freshmeat.pl: forgot about blootbot_pid - -2000-09-13 21:38 dms - - * src/Modules/Debian.pl: non-us fixed! - -2000-09-13 21:36 dms - - * src/modules.pl: removed two debugging lines or so - -2000-09-13 21:19 dms - - * src/Modules/Debian.pl: Removed fixNonUS; added a hack for no contents file for woody non-US i386 at least. - -2000-09-13 21:03 dms - - * src/core.pl: bot: spit out memory change messages in DCC CHAT. TODO: DCCBroadcast should allow userflag arg. - -2000-09-12 23:33 dms - - * src/Modules/Topic.pl: Another regex topic fix - -2000-09-12 23:12 dms - - * src/db_mysql.pl: Fixed up stub dbGetRowInfo - -2000-09-10 22:40 dms - - * src/logger.pl: was opening sql debug file for read, not write. typo - -2000-09-10 01:09 dms - - * src/IRC/Schedulers.pl: changed verb level from 2 to 1 for seenFlush - -2000-09-10 00:36 dms - - * src/IRC/Schedulers.pl: debug for seenflush - -2000-09-10 00:30 dms - - * files/sample.config: SQLDebug line - -2000-09-10 00:28 dms - - * src/modules.pl: forgot to set module age if successfully loaded. split reloadModules into reloadAllModules and reloadModule. &reloadModule() now called by loadMyModule() - -2000-09-10 00:24 dms - - * src/logger.pl: supressed subroutine redefined warning. Added sql debug support (open/close) - -2000-09-10 00:19 dms - - * src/db_mysql.pl: Added sql debug support (print) - -2000-09-10 00:16 dms - - * src/Modules/UserDCC.pl: fixed/added global factoid SAR - -2000-09-09 22:41 dms - - * src/Modules/Topic.pl: fixed regex line, founded by Flugh - -2000-09-06 23:00 dms - - * src/Factoids/Update.pl: minor change - -2000-09-06 22:59 dms - - * src/logger.pl: 'use strict' issue - -2000-09-06 22:57 dms - - * src/Modules/UserDCC.pl: global SAR. only avail to +n and DCC. - -2000-09-06 22:56 dms - - * src/core.pl: fixed due to changes. (re: Flugh) - -2000-09-05 23:47 dms - - * scripts/: dbm2mysql.pl, mysql2txt.pl, setup_tables.pl, - setup_users.pl, txt2mysql.pl: forgot to update these files in the root dir overhaul - -2000-09-05 01:55 dms - - * scripts/setup_users.pl: fixed up a bit - -2000-09-05 01:28 dms - - * src/logger.pl: stupid typo (carelessness) on my behalf - -2000-09-01 22:21 dms - - * src/UserExtra.pl: debug info for ircstats hash list - -2000-09-01 22:19 dms - - * src/IRC/IrcHooks.pl: added disconnect and connect stats, just debug info for now - -2000-09-01 21:18 dms - - * src/Modules/Topic.pl: prevent dupes to be added; added debugging info if bot is not permitted to add topics (+t/-o). - -2000-09-01 20:58 dms - - * src/IRC/Schedulers.pl: ircCheck now checks @joinchan for chans left to join, but should never happen. - -2000-09-01 20:56 dms - - * src/Modules/Debian.pl: debian: fixed broken files for woody's non-US - -2000-08-31 22:45 dms - - * src/CommandStubs.pl: lame warning fix for babel - -2000-08-31 22:41 dms - - * src/logger.pl: forgot a ) - -2000-08-30 21:33 dms - - * src/Modules/Uptime.pl: Added catch just in case if forked - -2000-08-30 21:14 dms - - * src/Shm.pl: changes due to Debian.pl - -2000-08-30 21:12 dms - - * src/Modules/Debian.pl: minor changes, removed 'slink', changed 'stable' for 'potato' - -2000-08-30 21:09 dms - - * src/Factoids/Update.pl: added debugging info for '.,' and '.,' problems - -2000-08-30 20:42 dms - - * src/logger.pl: added $forkedtime, for debugging - -2000-08-30 20:19 dms - - * src/CommandStubs.pl: preliminary command hook support added - -2000-08-20 22:17 dms - - * src/Modules/UserDCC.pl: closed 17554 -- re-add part/leave to DCC CHAT only - -2000-08-20 21:58 dms - - * src/Modules/Debian.pl: we don't stop if debianDownload fails unless none of the files exist locally - -2000-08-20 21:46 dms - - * src/Modules/Debian.pl: shouldn't recursively call sP - -2000-08-20 21:33 dms - - * src/Misc.pl: double fork -> VERB(2), minor cosmetics - -2000-08-20 21:28 dms - - * src/IRC/IrcHooks.pl: if statement of seen swapped. DCC CHAT close ignored if forked. - -2000-08-20 21:25 dms - - * src/Factoids/Reply.pl: added randnick - -2000-08-20 21:24 dms - - * src/Modules/Debian.pl: check for stality in sP() - -2000-08-19 20:10 dms - - * files/sample.config: closed 17225 -- result of fixed bug - -2000-08-19 19:24 dms - - * src/: User.pl, IRC/IrcHooks.pl: closed 17225 -- seen only stores addressed messages. Also moved seen code from User.pl to IrcHooks.pl - -2000-08-19 18:44 dms - - * src/Modules/Topic.pl: closed 17447 -- 'topic info' should give more info - -2000-08-15 19:27 dms - - * src/Misc.pl: warning (typo) fixed - -2000-08-15 19:26 dms - - * files/sample.config: deprecated weather option/feature removed - -2000-08-15 19:24 dms - - * src/IRC/Schedulers.pl: ircCheck(): added full path for ipcs,ipcrm - -2000-08-15 19:21 dms - - * src/IRC/IrcHooks.pl: on_disconnect schedules ircCheck*( for 1800s - -2000-08-12 20:45 dms - - * src/UserExtra.pl: don't prevent wantnick from working in any case - -2000-08-12 20:43 dms - - * src/IRC/Schedulers.pl: Added getNickInUse() - -2000-08-12 20:42 dms - - * src/IRC/IrcHooks.pl: on_nick_taken calls getNickInUse() now - -2000-08-12 20:41 dms - - * src/logger.pl: use getPath() for create logdir for openLog() - -2000-08-12 20:38 dms - - * src/Misc.pl: typo for file in loadHelp() ... added getPath() for openLog() - -2000-08-11 21:28 dms - - * src/Factoids/Update.pl: closed 17031 -- Fix up appending to factoids - -2000-08-11 21:21 dms - - * src/Factoids/: Reply.pl, Update.pl: closed 17187 -- are also ' doesn't work... also removed mailto: - -2000-08-11 21:10 dms - - * src/Modules/Math.pl: closed 17344 -- Maths.pl is borked in a way - -2000-08-11 20:53 dms - - * src/IRC/IrcHooks.pl: close 17091 completely... fix up on_nick IRC hook - -2000-08-11 20:48 dms - - * src/IRC/Schedulers.pl: closed 17091 -- chaninfo stats inconsistent after time - -2000-08-11 20:11 dms - - * src/modules.pl: Fixed problem with loadMyModules() caused by delForked() - -2000-08-11 20:10 dms - - * src/Modules/W3Search.pl: closed 17379 -- W3Search.pl gives duplicate output - -2000-08-04 23:19 dms - - * src/Factoids/Statement.pl: at -> mailto remnants from stock infobot removed - -2000-08-03 22:19 dms - - * src/logger.pl: status did not print output if config file was not loaded. Fixed by initializing VERBOSITY to 1 - -2000-08-03 22:11 gmlb - - * INSTALL.patches: Readme update. - -2000-08-03 21:53 dms - - * src/Modules/Kernel.pl: forgot about blootbot -> bot - -2000-08-03 01:04 gmlb - - * INSTALL.mysql, INSTALL: Fixed some documentation typOs. (in the install docs) - -2000-08-01 21:41 dms - - * src/CommandStubs.pl: userinfo had wrong argument # set - -2000-07-31 22:57 gmlb - - * infobot: - Removed old infobot. We are now using blootbot as the main script - -2000-07-31 22:37 dms - - * src/: IRC/Irc.pl, IRC/IrcHooks.pl, IRC/Schedulers.pl, - Modules/Countdown.pl, Modules/Factoids.pl, Modules/Freshmeat.pl, - Modules/Kernel.pl, Modules/Units.pl, Modules/Uptime.pl, - Modules/Wingate.pl, Modules/babel.pl: cvs commit borked, continuing - -2000-07-31 22:31 dms - - * AUTHORS, INSTALL, README, blootbot, doc/old/TODO, - files/blootbot.help, files/blootbot.ignore, files/blootbot.lang, - files/blootbot.lart, files/blootbot.randtext, files/blootbot.users, - files/ircII.servers, files/sample.config, scripts/botchk.sh, - scripts/dbm2mysql.pl, scripts/insertDB.pl, scripts/mysql2txt.pl, - scripts/setup_tables.pl, scripts/setup_users.pl, - scripts/txt2mysql.pl, src/Misc.pl, src/Process.pl, src/core.pl, - src/modules.pl, src/Factoids/Question.pl, src/Factoids/Reply.pl, - src/Factoids/Statement.pl, src/Factoids/Update.pl: Changed $infobot_ to $bot_ - Changed infobot to blootbot where needed - Renamed *infobot* to *blootbot* - -2000-07-31 20:47 dms - - * src/logger.pl: Added functionality to cycle all logs if exceeds specified size - -2000-07-31 20:33 dms - - * src/: CommandStubs.pl, UserExtra.pl, Modules/Topic.pl: changed NOREPLY to dollar noreply - -2000-07-31 20:10 dms - - * src/Modules/UserDCC.pl: send DCC message when using 'op' - -2000-07-30 08:33 gmlb - - * doc/README_TODO: Added README_TODO. It contains important info on the TODO list. READ! - -2000-07-30 08:01 gmlb - - * doc/: BUGS, Connection.pm, EXAMPLES, FAQ, Google.pm, TODO, USAGE, - mysql.txt, notes.txt, pgsql.txt: Removing old doucments in /doc. They are archived in /doc/old. The newest documents will be on the website. See /doc/README_NOW for more information. - -2000-07-30 07:56 gmlb - - * doc/old/: BUGS, Connection.pm, EXAMPLES, FAQ, Google.pm, TODO, - USAGE, mysql.txt, notes.txt, pgsql.txt: Moving documentation to /doc/old - -2000-07-30 07:51 gmlb - - * doc/README_NOW: Adding README_NOW. Please read it, as it contains very important DOC information - -2000-07-30 07:02 blootbot - - * AUTHORS: Updated personal info in AUTHORS file. Must talk to XK about title :) - -2000-07-30 00:11 dms - - * AUTHORS, patches/Connection.pm, patches/Google.pm: new/moved files - -2000-07-30 00:09 dms - - * INSTALL.patches, README, doc/USAGE, doc/modules.txt, - files/sample.config, scripts/backup_table-slave.pl, src/Files.pl, - src/Misc.pl, src/Net.pl, src/Shm.pl, src/UserExtra.pl, src/core.pl, - src/db_dbm.pl, src/db_mysql.pl, src/db_pgsql.pl, src/logger.pl, - src/modules.pl, src/Factoids/DBCommon.pl, src/Factoids/Update.pl, - src/IRC/Irc.pl, src/IRC/IrcHooks.pl, src/IRC/Schedulers.pl, - src/Modules/Countdown.pl, src/Modules/Debian.pl, - src/Modules/DebianExtra.pl, src/Modules/Dict.pl, - src/Modules/DumpVars.pl, src/Modules/Factoids.pl, - src/Modules/Freshmeat.pl, src/Modules/Kernel.pl, - src/Modules/RootWarn.pl, src/Modules/Slashdot3.pl, - src/Modules/Topic.pl, src/Modules/Uptime.pl, - src/Modules/UserDCC.pl, src/Modules/UserInfo.pl, - src/Modules/Wingate.pl: changed email address - -2000-07-28 23:26 dms - - * files/infobot.config, files/sample.config, src/core.pl: loadConfig to spurt out correct message when infobot.config does not exist on fresh install - -2000-07-28 23:11 dms - - * MrInfo.uptime: delete stale files not needed for fresh installation - -2000-07-28 00:59 blootbot - - * ChangeLog: Added a line to ChangeLog. I hope to keep this more uptodate and start documentatio. -GmLB - -2000-07-28 00:10 blootbot - - * INSTALL, INSTALL.dbm, INSTALL.mysql, INSTALL.patches, - INSTALL.pgsql, README, infobot, ChangeLog, MrInfo.uptime, doc/BUGS, - doc/Connection.pm, doc/EXAMPLES, doc/FAQ, doc/Google.pm, doc/TODO, - doc/USAGE, doc/modules.txt, doc/mysql.txt, doc/notes.txt, - doc/pgsql.txt, files/infobot.config, files/infobot.help, - files/infobot.ignore, files/infobot.lart, files/infobot.users, - files/ircII.servers, files/sample.countdown, - patches/Net::IRC.patch, patches/WWW::Search.patch, - scripts/backup_table-master.sh, scripts/backup_table-slave.pl, - scripts/botchk.sh, scripts/dbm2mysql.pl, scripts/dbm2txt.pl, - scripts/fixbadchars.pl, scripts/insertDB.pl, scripts/makepasswd, - scripts/mysql2txt.pl, scripts/oreilly_dumpvar.pl, - scripts/oreilly_prettyp.pl, scripts/parse_warn.pl, - scripts/setup_tables.pl, scripts/setup_users.pl, - scripts/showvars.pl, scripts/txt2mysql.pl, scripts/vartree.pl, - scripts/webbackup.pl, files/infobot.randtext, files/infobot.lang, - files/sample.config, files/sample.insert, files/unittab, - src/CommandStubs.pl, src/Files.pl, src/Misc.pl, src/Net.pl, - src/Process.pl, src/Shm.pl, src/User.pl, src/UserExtra.pl, - src/core.pl, src/db_dbm.pl, src/db_mysql.pl, src/db_pgsql.pl, - src/interface.pl, src/logger.pl, src/modules.pl, src/IRC/Irc.pl, - src/IRC/IrcHooks.pl, src/IRC/Schedulers.pl, - src/Modules/Countdown.pl, src/Modules/DNS.pl, - src/Modules/Debian.pl, src/Modules/Dict.pl, - src/Modules/Freshmeat.pl, src/Modules/Kernel.pl, - src/Modules/Quote.pl, src/Modules/RootWarn.pl, - src/Modules/Search.pl, src/Modules/Slashdot3.pl, - src/Modules/Topic.pl, src/Modules/Units.pl, src/Modules/Uptime.pl, - src/Modules/UserInfo.pl, src/Modules/W3Search.pl, - src/Factoids/DBCommon.pl, src/Factoids/Norm.pl, - src/Factoids/Question.pl, src/Factoids/Reply.pl, - src/Factoids/Statement.pl, src/Factoids/Update.pl, - src/Modules/DebianExtra.pl, src/Modules/DumpVars.pl, - src/Modules/Factoids.pl, src/Modules/Math.pl, - src/Modules/UserDCC.pl, src/Modules/Wingate.pl, - src/Modules/babel.pl, src/Modules/insult.pl, - src/Modules/nickometer.pl: - Trying to add 1.0.0. I hope it works. --GmLB - -2000-07-28 00:10 blootbot - - * INSTALL, INSTALL.dbm, INSTALL.mysql, INSTALL.patches, - INSTALL.pgsql, README, infobot, ChangeLog, MrInfo.uptime, doc/BUGS, - doc/Connection.pm, doc/EXAMPLES, doc/FAQ, doc/Google.pm, doc/TODO, - doc/USAGE, doc/modules.txt, doc/mysql.txt, doc/notes.txt, - doc/pgsql.txt, files/infobot.config, files/infobot.help, - files/infobot.ignore, files/infobot.lart, files/infobot.users, - files/ircII.servers, files/sample.countdown, - patches/Net::IRC.patch, patches/WWW::Search.patch, - scripts/backup_table-master.sh, scripts/backup_table-slave.pl, - scripts/botchk.sh, scripts/dbm2mysql.pl, scripts/dbm2txt.pl, - scripts/fixbadchars.pl, scripts/insertDB.pl, scripts/makepasswd, - scripts/mysql2txt.pl, scripts/oreilly_dumpvar.pl, - scripts/oreilly_prettyp.pl, scripts/parse_warn.pl, - scripts/setup_tables.pl, scripts/setup_users.pl, - scripts/showvars.pl, scripts/txt2mysql.pl, scripts/vartree.pl, - scripts/webbackup.pl, files/infobot.randtext, files/infobot.lang, - files/sample.config, files/sample.insert, files/unittab, - src/CommandStubs.pl, src/Files.pl, src/Misc.pl, src/Net.pl, - src/Process.pl, src/Shm.pl, src/User.pl, src/UserExtra.pl, - src/core.pl, src/db_dbm.pl, src/db_mysql.pl, src/db_pgsql.pl, - src/interface.pl, src/logger.pl, src/modules.pl, src/IRC/Irc.pl, - src/IRC/IrcHooks.pl, src/IRC/Schedulers.pl, - src/Modules/Countdown.pl, src/Modules/DNS.pl, - src/Modules/Debian.pl, src/Modules/Dict.pl, - src/Modules/Freshmeat.pl, src/Modules/Kernel.pl, - src/Modules/Quote.pl, src/Modules/RootWarn.pl, - src/Modules/Search.pl, src/Modules/Slashdot3.pl, - src/Modules/Topic.pl, src/Modules/Units.pl, src/Modules/Uptime.pl, - src/Modules/UserInfo.pl, src/Modules/W3Search.pl, - src/Factoids/DBCommon.pl, src/Factoids/Norm.pl, - src/Factoids/Question.pl, src/Factoids/Reply.pl, - src/Factoids/Statement.pl, src/Factoids/Update.pl, - src/Modules/DebianExtra.pl, src/Modules/DumpVars.pl, - src/Modules/Factoids.pl, src/Modules/Math.pl, - src/Modules/UserDCC.pl, src/Modules/Wingate.pl, - src/Modules/babel.pl, src/Modules/insult.pl, - src/Modules/nickometer.pl: Initial revision - -v1.0.0 (20000725): bug fixes mainly. - - GmLB found that scripts/setup_*.pl didn't work. Fixed. - - Fixed warning in Modules/Uptime.pl for clean install. - - More fixes for scripts/*mysql*.pl from GmLB. - - Added command 'hex'. - - GmLB fixed mysql2txt.pl and txt2mysql.pl. You can now import and - export to inforbot 'factpacks'.- - -v1.0.0RC3 (20000720): bug fixes mainly. - - Debian.pl's infoPackages() now checks for incoming - automatically and shows the new file. - - irq/dan found the bot wouldn't run if a stale (invalid) pid - file exists. Fixed. - - Created &closeDCC(), &closePID() - - Added factoid SAR of (3-123) => 53 - -v1.0.0RC2 (20000707): - - Ported back Berkerley DBM support. 95% of it works :) - - Also added pgSQL support. Will not work out-of-the-box. - - Updated README. - - Fixed up 'modules.pl' a bit so if anything fails, it exits - gracefully. Module reloading should work better now. - - DCC CHAT commands now must have '.' prepended otherwise all text - will me broadcasted to the dcc chat arena. - - Removed command 'part'. Use 'kick' instead :) - - 'random|cookie' now takes argument to narrow down randomness. - - Merged 90% of MbM's@OPN modifications. Thanks. - => bug fixes here and there - => 'tell' fixed. - => checks for owner of factoids for delete/modify factoids - - Moved Factoids/db* to . - - Misc stuff here and there. - -v1.0.0RC1 (20000701): - - Added several hacks (run away fork) due to bot misbehaving. - - Added deop. - - Added ability to disable factoid support. - - Reorganized source tree to be more modular. - - Created dirs: IRC, Factoids. - - moved partial core.pl and PerlMod.pl to modules.pl - - renamed Modules.pl to CommandStubs.pl - - Added command 'cycle'. - - hardguy/max noted that insult was borked. It wasn't converted - to the new fork format. Fixed but untested. - - Added 'ircstats' command. forgot about DisconnectReason - - Added to-expire-time on 'ignorelist' - - Forgot to clear %ignoreList on loading the list. - - moved 'ignorelist' from DCC-only to public/private msg. - -v1.0.0pre11 (20000601): - - we call &ircloop() if we want to reconnect. Any harm to perl? - - Wingate fixed yet again. maximum time for response is 6secs in - order to cache maximum number of hosts. - - Added ban() for Wingate. - - Forgot about virtual host support when changed over to Net::IRC - - process() still calls shmCycle() just in case. - - Added limit to how many random things we can have in a factoid - to prevent endless loops from occurring. - - All debian stuff now fully forks -- good. - - Failure on &loadMyModule() now deletes $forked{$label}. - - if instructed to join a channel "manually", tell who did it on - join. - - Debian module now searches woody's non-US properly. Misc fixes - here and there. - - Removed non-working mysql table locking code. - - Freshmeat.pl now uses LWP::Simple's getstore. How to load the - file on-the-fly? - - Looked at Modules-Reload and implemented idea in the bot. - - Forgot about flushing uptime in scheduler. - - Added unit conversion feature to bot, based on Units-Convert - package (at CPAN). - - Converted several scalars to hashes. - - Added slashdot,freshmeat and kernel announcements of new stuff. - - merged chanstats into one line, added top msg stats. - - Wingate now does intelligent on-the-fly caching and flushing to - a wingate file to prevent dupes. UNTESTED - - "find pident potato" now works after few mods/hacks :) - - ... - -v1.0.0pre10 (20000523): - - Fixed minor problems in Debian.pl, I hope. - => DebianDownload now calls generateIndex() if a download is - successful. - => More clean ups. - => generateIncoming() forgot about checking stale of idxfile. - - Modules in Modules/* now dynamically loaded. Using about ~200k - less ram now. - - Added support of user modes with param{ircUMODE}. Requested by - Flugh. - - hookMsg modified, we don't check ignore list if we're not - addressed or minvollength is defined. flooding is now - configurable by repeated message and total message, expire time - and count, like eggdrop. - - nickometer didn't reset the score. noticed by greycat+others. - - &setupScheduler() scheduler is only called once. - - UIS now supports proper locking and lock check. - - verifyUser didn't set userHandle to 'default' if not found. - - Added factoid reply support of '(blah1|blah2)?' - - Added 'FAQ'. - - Added DebianExtra.pl module to list bugs. a hack and ugly! - - Finally fixed list of old topics in Topic.pl, courtesy of mux - and nicholas_. - - Removed usage of quotemeta, replaced with \Q\E pair for regex. - - Included patches to modify stock-brokeness of perl modules. - 'cd /usr/lib/perl5; cat *.patch| patch -p0' - - Setup option whether to cache user online stats. Disabling will, - for sure, won't bloat the bot by 2-4megs (but why that much?). - -v1.0.0pre9 (20000512): - - Typo for outsider checking. Noticed when #debian flooder came - back yet again :) - - seenCycle was in minutes instead of days. fixed. - - Added User Information Services module. requested by Flugh. - => 'uinfo ' - => 'uinfo set ' - => 'uinfo unset ' - - Added &IsNickInAnyChan($nick); - - Added &DCCBroadcast($txt) to broadcast messages to all members - of DCC CHAT. - - &say() now changes '0' to 'zero' due to Net::IRC bug. - - Added &GetNickInChans($nick); - - Merged fooz's wingate scanner. - - Added 'ignoreAutoExpire' to differentiate time for ignore due to - flooding instead of 'ignore' through DCC CHAT. - => remove time for 'ignore' through DCC CHAT? - - Added &debianCheck() to check state of gzip'd files. - - ... - -v1.0.0pre8 (20000505): - - usual backlash from upgrade. - - added 'useStrict' option to infobot.config. - - added 'reload', to reload Core and Extras Modules. Does it - reload only if the file has changed? - - added preliminary (debug) code for ftpGet() for truncated - downloads. regetting will be added soon afterwards. - - minor fix for Debian.pl where a package exists but an - incomplete Packages file may not have info on that package. - - Modified on-the-fly ignore to be temporary. temporary ignore - requested by jCommons. - - added 'factstats requester'. - - preliminary use of scheduler for &checkPing() in &on_init(). - no event hook on 'pong' :((( - - Timers now use Net::IRC's scheduler, woohoo. Nice change over. - Moved ProcessExtras.pl to Schedulers.pl. - - Added 'factstats deadredir'. - - Don't prevent auto-reconnecting due to disconnection. - - Forgot initialization before any new IRC connection. - - Added scheduler for checking IRC connection. - - Fixed problem in Freshmeat module, if forked to download, would - not continue with query. => now it does, nice hack. - - Debian module should generate incoming index if does not exist. - - Chatting can be done through DCC CHAT. - - ... - -v1.0.0pre7 (20000426): - - INSTALL and README updated. - - auto-request for ops after joining all channels instead of after - each channel join. - - If factoid is requested by someone, show literally (no - evaluation) if owner of factoid matches aswell as if requested - privately(good idea?) - - on_notice fixed and debugging info removed. - - Added reconnect on HUP if we're not connected. I hope that it is - set to 0 otherwise this solution is dead. - - ';' added as address char. - - maths bug found by NoNix4. - eg: 6000.0/9.000 - 6.000/9.000 - 666.00001 - - nickometer bug (pi not defined) found by ddent. 'strict' cleanup. - - Preliminary CLI code included. Good for local use. - - typo in Topic.pl, found by jCommons. Fix for NULL topic. - - minor Debian.pl update to deal with 'missing files' on download. - - multi-shmwrite support added. looks like it doesn't "refresh" - the value properly if written many times. - - &verifyUser() only used if addressed. - - Applied 'use strict' to all code. Also used 'use vars qw()'. - - Added 'backlog #' to DCC CHAT. requested by jCommons. - - ctcp version reply wrong; FIXED. found by fooz. - -v1.0.0pre6 (20000407): - - README updated. - - Added retry on failure to reconnect through on_disconnect(); - REMOVED -- this spun an endless loop. - - Found why Googling didn't work. See README for fix. - - Forgot about channel casing bugs (on_{join|part}) after - changeover to Net::IRC. - - Changed addForked() to cycle through fork list and delete stale - forks in case a forked child dies unexpectedly. - - Renamed allowOutsiders to disallowOutsiders just in case if the - option is removed from the configuration. - -v1.0.0pre5 (20000331): - - setup_users.pl. DBI*() => sql*(). - - 'topic add BLAH' on empty topic would bork. Why didn't I pick - this up before? - - Somehow I removed (or it wasn't there) 'my @results' from - searchTable(); - - nickometer now uses loadPerlModule()... another 500 kB saved :) - - repeat flood detection prevention added. - - Added el-cheapo hash key counter... possible leak detector. - - Added 'factstats lame' for short and most probably stupid - factoids. - - Weather module removed - - Renamed 'join' to 'joinchan' to due warning//conflict raised - with perl 5.005 (on potato not slink). - - Disabled syscall (removes 300 kB on slink, 3megs on potato) - -v1.0.0pre4 (20000323): pseudo AutoLoader support. - - 'infobot' now first loads core.pl and logger.pl. - - timerExpire() fixed. - - Added unique maintainer count to 'dstats'. - - Added demand-on-load of external perl modules. Now we need - dynamic(on demand) loading of 'Modules/*.pl' modules ;) - -v1.0.0pre3 (20000319): - - Fixed Freshmeat.pl not to show duplicate packages found by - 'name' and 'oneliner' search. Made showPackage() function. - - Debian modules now does multi distro. (woody's non-us appears to - be different structure so does not work :(, very crude hack... - may not even work). - - Added subfactoid randomising. eg: '(one|two|three)'. - - 'dauthor' now works! - - karma fixed... used the wrong var name. - - Fixed doubling of text when message from 'nick' is ignored. - - Added 'redir' to designate one factoid as master and duplicates - as redirectors//slaves. - - Added addressing recognition character(s) support. eg "!status". - - Seen info now cached and flushed at intervals or upon exiting. - - Added 'EXAMPLES' file to doc/. - - Removed ancient '&channel()'. - - Bug fixes after offshore installation of bot. - - Debian output of 'info' fixed. looks like 'fm', heh. - - Debian distro stats added. I'm competing with larne and his mods - to dpkg@OPN#debian :) so far so good. - - Forgot to close shm upon exit, heh :) However this does not - prevent leakage when the bot crashes. - - Parameter 'forking' now works, courtesy of generic &Forker() - function, woohoo! Now we use &Forker() for _everything_. - I had this in the todo list, removed it and decided to implement - it once and for all. - - More bug fixes when moved changes to 'apt'. Several "bug - reports" sent from #debian, thanks! - - Moved infobot communications _after_ ignore checking code. - - babelfish changed format? disabled for the time being. - - ... - -v1.0.0pre2 (20000310): BETA TEST RELEASE - - Hacked multiple mysql connection support in. - - Renamed DBI to SQL, including functions. - - Added $ishost. - - Added backup scripts to create and mirror tables. - - listauth fixed. - - Added parse_warn.pl to decipher warn messages from logs. - - shm* now works. no more fork floods ;) - - Applied fork protection on all forking modules. - - Dict feature now supports specific retrival of definition, - however, default is still random. - - Debian feature now supports multiple sub distributions. This can - be further extended to architecture (perhaps easily). - - Added (but commented) larne's regex for debian search. - - Added &hasParam() to include notification that a feature - (command) requested is disabled in configuration. - - Added dumping of memory stats. - - Fixed broken timerExpire(). - - Added auto shutdown of bot if too much ram is used. - - Modified seen feature, set to off by default. - - UPDATE: fixed, about time. - - Improved parse_warn.pl to be like "diff". - - Dollar variable addition?? suggestions by ddent. - - 'factstats dupe' now ignores ' see'. - - UPDATE: fixed. - - Added random factoid timer. - - Don't redownload file via getFTP() if local and remote sizes are - the same. - - Added $count{'Dunno'} for unanswered questions. - - Fixed 'blah is also or' since we didn't allow 'or'. - - Added 'factstats redir' to display factoid redirections. - - Grep nick from list of nicks in IsNickInChan(). Bug found by - Mercury. - - Time taken and final xfer rate displayed in FTP. - - Fixed bug where 'or' is eval'd in Math.pl. Return '' if eval() - is not done. Bug found by dent. - - Added 'factstats redir' to list working and non-working - redirected (symlink) factoids. - - cmdstats now sorted by highest->lowest usage. - - ... - -v1.0.0pre1 (20000130): - - Mostly converted to Net::IRC, quite nice, like the dbm to mysql - change over :) - - Removed IrcHooks.pl and CTCP.pl. - - Moved hooks stuff to IrcHooks.pl. - - Moved IrcExtras.pl to Irc.pl. - - Removed ansi_control option. colors can be stripped within - &status() anyway, like for logging. - - Added DCC CHAT and DCC SEND support base. - - DCC SEND: null file. due to fork()? Fixed anyway. - - DCC CHAT: person's responsibility to close DCC CHAT. - -v0.99pre12 (20000125): - - Added intelligent flood protection and removed factoid - repetition prevention. - - Modified Math.pl... - - Unified tell code in Process.pl. - - Moved variable fix and addresing code to IrcHooks.pl - - Moved tell code from Question.pl to UserExtra.pl. - - Found that % and \ were double backslashed; added it to invalid - factoids. May have been caused by whoever unbacked up 'apt', - cerb? :) May want to add a function to automatically fix badly - formed factoids. - - Added 'factstats profanity', with &hasProfanity($str). - - Added functions for shared memory usage. - Uses: prevent exploitation of forked processes. - - Added 'factstats unrequested'. - - stale variables (vhost_name) forgotten in changeover. - - UPDATE: - - Fixed major leak with cycling of flood messages, typo :) - -v0.99pre11 (20000123): - - Fixes here and there... - - Debian find now searches Package names. Fallback automatically - to contents file search. - - Fixed typo related to log cycling. - - Added netsplit detection code. - - Started DCC support... very early stages. - - Replaced several 'foreach' statements with 'if' for efficiency. - About 5 instances of code... - - Debian contents search ignores man pages (unless search string - obvious for man page). Suggested by sgore. - - 'factstats locked' returns list instead of only count. - - &DoModes() bug found by larne. - - Used '$nick' instead of 'lc $nick' for $channels. - Found by larne. - -v0.99pre10 (20000119): - - Fixed bugs found when moved code to 'apt': - - added '^' and '|' to $isnick. - - removed 'local' and 'my' for some global vars. - - Typos of some variable names. - - More typos. - - Debian.pl contents search is better now. - - UPDATE: made changes suggested by greycat. - - Added Packages query now... - - Added &getRandomLineFromFile() - - Added LART, random text, Channel limit adjuster. - TODO => Wingate checker (NOT COMPLETED)... - - Added &iseq() and &isne(). - - Help info is not cached any more => loaded each time help() is - called. - - Added %timer hash, timestamp when something was last done. The - hash name is incorrectly named, eh? - - Moved parts of Process.pl to ProcessExtra.pl. - - Moved parts of User.pl to UserExtra.pl. - - Moved myRoutines.pl to UserExtra.pl. - - Moved Extras.pl to Modules.pl. - - Removed fortran math due to poor code style. - - Moved parts of Question.pl to UserExtra.pl. - -v0.99pre9 (20000115): - - Added messagecount column for 'seen'. Not used as yet. It - appears to be pointless, yes? - - Cleaned up DBI.pl: made use of $dbh->quote(); added - &DBIRawReturn(), &DBIInsert(), &DBIUpdate(). - - Forgot to clear $tell_obj after successful 'tell'. Founded by - solomon. - - Extra modules loaded only if enabled in config, may save some - ram. - - Math.pl cleaned up. - - Added DumpVars.pl, now we know where things are being leaked. - - Removed duplicate 'use IO::Socket'. - - Typo in "disabled" locking code which didn't work :) Founded by - washort. - -v0.99pre8 (20000110): - - Bailout if critical configuration variables are not found. - - Dict.pl works well now. - - Topic.pl now uses %topic or @topic. Added 'topic info' which - contains who and time info. How does @{$hash{$key}} work? - - Used 'use diagnostics;'. Fixed most warnings. - - Added &WARN(). - - Minor typo in &IsInvalid() on last statement, heh. - - Fixed (DAILY) logging, finally. Was broken too many times. - - Added &getLineFromFile() for debugging purposes. BROKEN - - Added Debian search-engine frontend => Debian.pl. - UPDATE: forget mysql, takes too long. - - Added Countdown => Countdown.pl. - - Made use of 'unless' instead of 'if !'. - - Added &DBIRaw(). - - Addressing required on all commands. - - Added &fixFileList() to simplify files with common directories. - - RevHippie stumped me with the best method to write this, - heh. Why do I always try to do things in 1 loop instead - of 2 loops? - -v0.99pre7 (19991230): - - Renamed some setup/DBI calls. - - Simplified nickserv/chanserv code. chanserv opping may break - though. Experimentation? - - Fixed broken stuff scripts/* due to src/* modification. - - Added table locking support. BROKEN. - - param{'ident'} deprecated. - - Removed param{'dbname'}, please rename the main table (with - factoids) to factoids.* - - Added ircII.servers support. - - Fixed infobot, Setup.pl and Files.pl. - - Freshmeat.pl fixed. Set the update time _before_ we update. - - Added factoid renaming. "rename 'from' 'to'". - - Added DBISetRow() for first time inserts, for Freshmeat. - Removed (rather used raw) use of fixmysqlbug for DBISetRow() - - Added 'seen random'; fixed randKey to work with 'seen'. - - Added preliminary code for whatis frontend. - - Added SIGHUP code for $SIG{HUP}. - - Added more error protection in DBI.pl. - - Moved logDate logging support to &status@Misc.pl. - - Confirmed logging does not duplicate from child any more. - - Added 'partialdupe' (not recommended) and '2long' to - &FactStats(); - - ... - -v0.99pre6 (19991223): - - Dict now fixed, courtesy of RevHippie and myself. - - Applied patch from RevHippie. - - Removed auto continuation code. - - Fixed learn =~ /HUNGRY/; - - Added $talkok and $learnok. - - Removed $param{'nick'} in favour of $ident. Added $safeIdent for - regex and made use of it. - - Moved Help.pl, Ignore.pl, Params.pl and part of User.pl to - Files.pl. - - Removed Internic.pl and Traceroute.pl. - - Fixed $isnick, renamed and fixed &purifyNick(). Added nick - compliancy checks when connecting to IRC server. - - Rewritten 'spell' code. - -v0.99pre5 (19991220): bug fix release. - - setupmysql.pl, slightly different for potato. - - dbm2mysql.pl - - performReply(), removed $trailing. FIX LATER. - - Freshmeat.pl, forgot about &main::, again. - - logType, broken date value. - - Fixed broken 'tell blah about what', readded $answer var. - - minLengthBeforePrivate superseeds preferReply. - - Forgot to use 'my' on three instances of $sth. - -v0.99pre4 (19991219): - - Added 'dupe' for factstats. - - Added illegal character detection in Statement.pl. - - Unified output (and duplication) of factstats (and other) code - to use one function, &formListReply(). Reduced code by at least - 2k :))) - - Minor modifications to &DBIGetCol(); - - Move +s flag to 'set search' in infobot.config. - - Altered talkMethod to allow 'private' or 'default'. Made no - sense to have it on public-only, heh. - - friendlyBots will be kept to be compatible with other stock - infobots but soon enough multiple mysql database support will be - added. Will be quite nice once done. - - Added maxListReplyCount and maxListReplyLen. Read infobot.config - for details. - - Replaced $refresh with freshmeatRefreshInterval to config. - - Changed learn setting from ALWAYS to HUNGRY. - - Reorganised Extras.pl, we shouldn't bail out if the command - can be disabled as the person who runs the bot should have - brains. - - Moved some Process.pl stuff to myRoutines.pl. - - --- - - &searchBy*() allows ^ and $, like in regex (basically sar'd). - removed $notexact variable. - - Fixed 'no,blah is blah' bug. - - Changed 'is also' char to ';;'. - - Added &IsInvalid(); to unify Statement (when creating) and - factstats/broken (when checking/verifying). Works like a charm - :))) - - Removed sane stuff; added infobot.ignore. I hope lenzo's - ignoreList code works. - - Fixed setupmysql.pl - - Moved repeatIgnoreInterval to minRepeat*Reply where * is Private - or Public. - - Now preferReply works. Wasn't hard as it first looked. - - Added global '+' flag support. - - Fixed logging: added logType param; if logType =~ /DAILY/, new - log is created daily. Date is time-of-day, aswell. - - added &fixMySQLBug() => adds backslash to special chars. - -v0.99pre3 (19991216): - - Fix connection bug where if host does not resolve, it appears - that it's connection refused. Now non-resolving hosts are - detected earlier. Found by some *.it (or .es??) guy. - - Added 'sync in #s' when the bot has joined a channel... just - like in BitchX. - - Added txt2mysql.pl. - - Removed instances of '^\s*' to '^' since $message can be - manipulated in Process.pl. - - Fixed Statement.pl so that it doesn't catch queries... it's a - stupid idea any way. - - Removed 'confused' in favour of 'dunno'. - - Funny hack in performReply(). Stupid but it works. - - Added 'host' column in seen table. - - Made use of &gettimeofday() for freshmeat and search function. - -v0.99pre2 (19991213): - - Made use of new database (directory) not to interfere with other - crucial dbs. - - Re-added &getKeys(), mysql's RLIKE wouldn't like "'" in the - statement. If several of similar queries are required, better - off using &getKeys(). - - Added two more conversion scripts. - -v0.99pre1 (19991211): personal release. MAJOR CHANGES. - - create a script to add the blootbot user to the mysql server and - prepare tables for use with the bot. - - butchered Question.pl, Reply.pl, Statement.pl and Reply.pl. - - main factoid db ported over; barely tested. - - seen ported over; appears to work. - - karma ported over; not tested at all. - - freshmeat ported over; fix brokeness. - - search (listvals and listkeys) ported over. - - rootwarn ported over. - - - Use quotemeta in DBI.pl on special chars, especially ' :) - - Added factstats 'broken' function. - - Made use of multiple connections to avoid clashing... does - clashing only occur when there's an INSERT/UPDATE or SELECT or - both? - - Changed $factoid to $faqtoid... good idea? how about $lhs? - - Changed getKeys to countKeys to take advantage of mysql. - - Added randKey to get random primkey,key from table. - - Removed process() when msgType == 'public action'. Why would we - want to care about actions anyway? - - Fix public action; Added private action to &status(). - - Added &ERROR(); - - Made message and who flooding independent in IrcHooks.pl. Now we - use %flood... should be expanded to use %ignoreList; - - NOTES... - - DBI.pl has more functions than what DBMExtra.pl had in order to - implement a table-like hash list. - - &DBISet() always verifies if an entry already exists and does an - UPDATE instead of an INSERT... flaw in mysql or my code??? - - &DBISet() can only set one (in UPDATE, two in INSERT), variable - at a time. Does this impose a performance hit? like on seen. - - ... - - TODO... - - infobot.cgi not ported over. - - weather not ported over. - - add alarm call between while in Dict.pl. - -************************************************* -************* CHANGE OVER TO MySQL ************** -************************************************* - -v0.18.2 (199912??): dropped. - - Fix for Weather.pl. - - Fix for Dict.pl. - - ... - -v0.18.1 (19991130): last public release before database change over. - - Modified &IsNickInChan() so that a foreach is done case - insensitively against nick to prevent misses. - - Added server "jump" support, requested by larne. - - Added seenMaxDays, maximum number of days to keep seen info on - someone, otherwise delete it. - - Forgot to use $main:: in Freshmeat.pl and Weather.pl; fixed. - - Changed userList format to $userList{$user}{$flag}{$what} = 1; - Converted all code to use this userList format. - - Changed version string to include OSname. - - Replaced $locWho with $who or $origWho. - - Removed hidden whitespaces and tabs at and of statments. - -v0.18.0 (19991128): - - Post release typo fixes here and there. - - Changed lc() to tr/A-Z/a-z/ where suitable. - - Redid join command in Process.pl. - - Cleaned up regex (mainly .* => \S+). - - Found $ischan to be broken; fixed. - - Changed Slashdot3.pl to have "joining" code like in DBMExtra.pl. - - Made use of &nick() and &IsChan(); - - Added &kick() to Misc.pl; kick command to User.pl. - - Added &IsNickInChan(); - - Fixed loading Param file before pidfile and other file related - stuff. - - User.pl - - Revamped; removed unused functions. - - Moved Set.pl to here. - - Moved 4op code here. - - Moved some functions from Process.pl to here. - - Rewrote rehash command. - - More casing fixes; debugging info _should_ help to find more. - - Changed infobot.users. - -v0.17.0 (19991126): - - Netsplit code prevented stats of signoffs; fixed. - - Messed around with logging code to prevent control chars. - - Removed exchange and excuse module because of brokeness. - - Applied patch from RevHippie. Thanks! - - Added delimiter support in addressing of hello msg. - - Removed 'score' in karma. - - Added 'learn' (ALWAYS or ADDRESSED) support. Normal - operation == ADDRESSED. Bot won't respond voluntarily to - factoids but will respond to learning. - - Ability to turn off minVolunteerLength. - - More changes to prevent chatter in unaddressed manner. - - We remove any ansi or control chars when piping to the log file. - RevHippie++. - - Added 'thanks' language. - - Typo in Freshmeat.pl; Fixed. - - Added $rootwarnmode = passive || aggressive to satisfy lilo@OPN. - default is passive. - - Fixed mix up of fix in 'tell' code. I had the if statements the - wrong way around. - - Removed more debug code. - - FactStats/author fixed; now multiple authors with the same stats - are printed together. - - Added logfile cycling w/ approx maximum size. - - Changed infobot.config yet again. now it's much better than - before. Some variables removed. - - Added Unset support to Set.pl; Changed so anything can be set - or unset. - - Made use of &purifyNick() so regex doesn't break. $safeWho - now defined earlier. - -v0.16.0 (19991122): - - Applied bug fixes from infobot 0.44.3, added md5 password - support (*BSD?). - - Added &IsParam() to check existance of params the proper - (strict) way. - - Moved rootWarn stuff from Extras.pl to RootWarn.pl. - - filenames (rootwarn and uptime) now not statically set. - - Cleaned up config file and Setup.pl. - - Fixed up &parsectcp() in CTCP.pl. - - Changed ($ischan) to (\S+) in Irc.pl under PRIVMSG. - - Major reorganisation of Misc.pl -- removed unused functions. - - Moved some variables to 'infobot'. - - Fixed ANSI typo by some loser; Changed format of &status()'s in - Irc.pl, seems to look nice thus far. - - Added "author" command under &FactStats() in DBMExtra.pl. - - Added case insensitivity to &IsHostMatch() and search strings in - DBMExtra.pl. Any more of these? - - Removed disabled netsplit code. - - Changed 'defined' to 'exists' on all hash lists, 'cept hashes - created by opening db's. - - Modified repeat code on modified_time. If this time is small, - msgType is changed to 'private' for flooding reasons and - max_time is reduced by half. latter appears not to work??? - -v0.15.0 (19991112): - - Quite funny that once the repeat code was moved to Question.pl - factoid extension leakage was found. maths leakage was also - happening but somehow is fixed when the repeat code was moved - back. - - Clean up of variable names in Reply.pl and Question.pl - - Changed 'length' to 'eq ""' or 'ne ""' where possible. - This should produce faster code but benchmarks prove this change - is neglible. Guess perl is slow :) - - Cleaned up and fixed 'tell about ' code. - - Set.pl fixed; Added DEBUG to allowable set list. - - Volunteer code moved to top of Question.pl. - -v0.14.0 (19991110): - - Message overflow fix in &FactStats(). - - Added 'factstats new' command to display new factoids in the - last 24 hours. - - Fixed up ping reply, requested by a few from #debian@OPN. - - Re-added debugging of DBMExtra due to leakage of orthaned - factoid extensions. Need to investigate and confirm the - lowercase fix of factoids. - - Two functions which used &mkRandom() now fixed due to poor - effort in implementation. Added missing srand(). now the maximum - length of 475 should not be exceeded, hopefully. it can be - beefed up to 490 if needed. - -v0.13.0 (19991108): - - Made use of &help() which uses infobot.help. This paves the way - for NLS as suggested by njs. - - Fixed up code on netjoin/netsplit in an effort to find - statistics leakage. Added debugging info to netjoin/netsplit. - - Fixed typo (three instances) in factinfo where time() was used - instead of the data in the factoid extension. Found by larne. - - Allow main thread to do a clean exit while the child does - nothing. Possible fix for weird uptime info. - - Removed sar of 'your|i|you|me' to prevent automated reverse - persona which is better done by the user. Suggested by njs. - - Cleaned up behaviour of &FixPlural(). Fixes a bug. - - Repeat prevention code now replaced (moved aswell) to use - factoid extensions - - Fixed 'factstats requested' error. - -v0.12.6 (19991103): bugfix on bugfix release ;) - - Fixed bug where you can't lock a factoid because the hostmatch - ($thisnuh = "") failed. Found by wolfie. - - Fixed up 512byte overflow in factstats[requested]. - - hm... wonder how I broke Weather.pl. - -v0.12.5 (19991101): Bugfix release - - Fixed "bad" array in Freshmeat.pl. All appologies to scoop. - [update: use array[5] if it exists, otherwise do as before.] - - Removed some debugging info from DBMExtra.pl. - - Fixed inconsistent chanstats behaviour in SignOff. - [Update: forgot to delete the user info _after_ we do the stats] - - Moved factoid stats count and repeat checking code to - Question.pl. Now it works as planned :) :) :) - -v0.12.4 (19991028): - - Added factstat and listauth commands. - - 'topic add' now prepends subtopic not append. - - Fixed up minor problem with 'topic restore last'. - - Changed default of locking access to people who own their - factoid or to registered ops. This should please #debian. - - Reduced usage of @{$var} which cannot be really deleted cleanly. - - Moved DBMExtra-related stuff from myRoutines.pl to DBMExtra.pl. - - Added new functions &mkRandom() and &getRandom(). - - Changed all code (Search.pl) which used random to the one - developed in DBMExtra.pl. => made code slightly smaller. - - Cleaned up Search.pl to look nice. - - Found yet another casing bug under TOPIC in Irc.pl. - - Fixed bug where dbmextra queries where made on non-factoids like - maths and probably karma. - -v0.12.3 (19991025): - - Added while loop around connect which should prevent the bot - from falling down (dying). - - Forgot 'main::' for &getURL in Freshmeat.pl. Changed - opening/closing code yet again. Removed checking on open - read-only. - - Changed Dict.pl to reply private only by default. '+' will allow - public responses without suggestions/synonyms. - - Added checking against pidfile. running two bots from the same - dir at the same time using the same db == disaster. Ask #debian - about it :) - - Implemented Weather.pl. - -v0.12.1 (19991022): - - Made distribution out of infobot -> blootbot. - - Irc.pl was prone to be fucking up -- swapped (.*) to (\S+) where - necessary. stab lenzo for this :) found more instances of this. - [update: appears to trap too many of something, check - 'chaninfo #chan' for info.] - - Minor fix for Freshmeat.pl when opening/closing db. - - Factoid extension code is ready for testing. possible in the - future to add "factstats" for like: top 3 requested factoids. - [update] added lock checking on sar and on updates ("no, "...) - -v0.12.0 (19991020): (v0.11.6 + bugfixes + trial) - - Major shake-up of how addressing is handled -- damn it took me a - long time to get this to work. - - Changed command names in Topic.pl to &topicBlah(). - - Found and fixed (hopefully) all 7 channel casing bugs. - - Moved freshmeat to use berkeley db instead of raw appindex.txt - file. finally got it to work, seems 30% faster. Creating the db - takes a long time though. - - Added "set" command => Set.pl. - - Added support of talkMethod which behaves much like lobotomy. - In the future, talkMethod =~ /(lobotomy|none)/ may be used. - - Purged: METAR2.pl, NOAA.pl, UAFlight.pl. - - RootWarn only works if the bot is opped in the channel. - - Created performStrictReply() from performReply(). - - Quote.pl and Internic.pl now work. - - Fixed a few typos in myRoutines.pl - - Removed bold on dictionary. - -v0.11.5 (19991012): - - Fixed $chan to lowercase where appropriate. - - Fixed volunteer reply code... I guess it worked before but now - it is somewhat cleaner and easy to understand. - - Added factoid owner database, requested by njs. - - If public message is addressed to someone else, we ignore it. - - Now support referer factoids ('blah is see erp'). if - 'blah' is asked, the reply from 'erp' is given. - - OPN allows part messages -- fixed in /PART/ for $chan. - -v0.11.3 (19991008): - - Uptime.pl appears to be fixed after rewrite of getUptimeInfo. - - Fixed up Freshmeat.pl for updating the index. Proxy is now - optional. - - Moved rootWarn to RootWarn.pl. Added hall-of-fame of losers. - - Cleaned up bugs/typo here and there which may have caused the - bot to behave in a weird manner. - -v0.11.2 (19991006): - - ChanInfo now displays "statistics" just like our little friend - BitchX. - - Minor change in determining args on commands [myRoutines]. - - Added "cmdstats". - - Added rootWarn checking on checks. Repeat offenders will be - punished. Requested by larne. [update: we aren't so harsh now] - - Added lc $chan where appropriate. damn uppercase channames. - -v0.11.1 (19991005): - - all instances of undef on hash lists changed to delete which - _now_ works. found minor bugs/typos related to DUI. - - Now skip internic whois intro (13 lines) to fix bad output. - - Forgot to subtract $i from $counter in chaninfo when full. - [update: whole function changed, see above] - - Now backup (and gzip) freshmeat index file. - -v0.11 (19991004): looks like a bug fix release :) - - Fixed typo in reply of Topic.pl/&NewTopic(). - - Decreased max topic length allowed; now print it, too, for - debugging. - - Altered repeat code to only work on public. Flooders should be - taken care of by the (allowOutsiders == 0) code. if not, there's - 'lobotomy' :) - - Added excess flood protection around &rawout(); - - Don't bother about outsiders if we haven't joined any channels. - - Changed email address to one throughout modifications. - New files have neato headers. - - Uptime.pl fixed, didn't need to check against ($pid == $$) - - Repeat-prevention code kind-of looks what it was before but this - one, at least, works :). any problems, just bitch at me. - - Added debugging code for chaninfo to diagnose "problem". - -v0.10 (19991001): - - Added Uptime module. - - Added Freshmeat module. - - Dict now returns definition without suggestions (syn's) by - default. Also cleaned up. - - NickServ/ChanServ major clean up. - - Join upon reconnect fix: set $joinchans = 0. - - Fixed up Help.pl, added more help entries. - -v0.9b (19990925): - - Did repeat-prevention code from scratch -- now works. - [19991001 update]: multiplier is now 2 instead of 10. - - Made reaction to "hello" more strict. the same should be done to - "thanks", don't you think? - - Converted remaining modules to use forking. should be no more - bot lockups... - - Changed maxhits to 20 for Search. - -v0.9 (19990924): +16K added to patch size. - - More, more and more major changes. - - Fixed up inappropriate usage of performReply. - - Added lobotomy command to (un)silence the bot. - - Added allowOutsiders toggle to prevent usage of the bot - _outside_ the channels the bot is in. - - Added $fullyaddressed, enabled if $addressed == 1 and - $param{addressing} == REQUIRE. - - Readded auto-continuity code. it is disable if not fully - addressed. otherwise works as per normal. - - Moved join-on-start-of-motd code to end-of-motd. If nickserv && - chanserv is enabled, IDENTIFY is done first. If okay, then we - proceed to join channels. - - When bot joins channel, summary of nicks (ops|voice|total) is - given instead of NAMES list. - - Chanserv support moved to "end of names". - - Detection of nickserv (no such nick). - - join channel if channel is on our joins list and if we're not on - it (hrm, providing their client prevents it). - - ... - -v0.8 (19990919): +50K patch from last version. - - Major changes, particularly cleanups and fixed a few bugs: - - Found 2 or so instances of $params{}. Either deleted or - renamed to $param where appropriate. - - Shortened foreach statements where possible. - - Replaced duplicate code involving &say and &msg with - &performReply($text,[0=rand,1=strict]). -- major shortcut and - cleanup. - - Added tracking of all users on channel(s). Users are - deleted if they disappear for whatever reason with - &DeleteUserInfo. - - Tracking of channels now works; they are deleted if we disappear - from any channel for whatever reason (hopefully). - - 'forget' command _SHOULD_ be wrapped with $addressed. - - Moved 'modes' from User.pl to myRoutines.pl as 'chaninfo'. - - Added stock quote support by using mu's script. Thanks. - - Added param{*} around stuff in myRoutines.pl for flexibility. - - Added auto-join on invite if not on specific "join_channels" - - Renamed &Timetostring to &Time2String and made use of it not - only for status but for seen. - - If $param{*} == false, it is now not defined. - - Removed Auto-continuity code -- very evil for any bot commands - other than non-intentionally requesting a factoid. - - crypt command required "(" before passwd??? - - Removed stupid commands which just generate URLs for you to cut - and paste. - - repeatIgnoreInterval code _NOW_ works unlike before. - - Added support for Topic.pl not to update topics if commands are - prepended by '-'. Topics can be "rehashed" when either a) the - next command is used without '-' or b) "rehash" is the next - command. - - &NewTopic takes two more args to prevent repetition and now does - topic checking. Check code for details. - -v0.7 (19990914): - - Major clean up: Search.pl now only uses the "is" dbm; final - pair of parens in commands removed for legibility; Removed - debugging for NickServ, ChanServ to go. - - Added multiple subtopic delete ability. requested by Mercury. - - Moved responses/replies to [files/infobot.lang]. Modified - related functions to conform, including mine. - - Fixed up Kernel.pl to use different type of sockets. Previous - code somehow broke itself. - - Added, but disabled, semi-working timer support. Need to ask - lenzo some questions on how to implement it the best way. - - Added channel (and offender's) notification if someone joins the - channel with root. requested by #debian. - - Added dict.org support. For now, it uses wordnet and returns a - random definition. Could change in the future. - -v0.6 (19990903): - - Added support for nickserv and chanserv, requested by is. - - Updated README to describe new features and modifications. Do we - need to elaborate on the modifications to the depth where it - would exceed the size of the patch? - - Minor clean up. - - Removed assumed-continuity of messages -- should be used if - addressing is in optional mode but would be bad in any situation - if more than one infobot existed in the channel. - - Added parsing of g flag to factoid sar. - -v0.5 (19990827): - - Better way to confirm if bot is on channel now for topic - management. Also added check for +o+t or -t. &DoModes() on - server stuff, too? - - Patch updated to work for infobot-0.44.2 only. - - Found a bug in Irc.pl under "NAMES" where $u was used initially - but trashed afterwards. => replaced $u w/ $_. - - Lost track of a bug found by Mercury. Seems to be fixed now, - somehow, heh. - -v0.4c (19990822): - - Worked on random-cookie -- random responses can now be added - (internally) with ease. - - Noticed joeyh changing his nick to/from '||' which reminded me - of something bad ;) hint: topic management. - - One line patch to allow '|' in factoids; delimiter is now '||'. - -v0.4b (19990818): - - Implemented patch from mu. Now it is possible to use the topic - command through private messages to the bot instead of the - channel. - - Replaced SAR of \| with \|\| so we can still use the single - pipes. Double pipes will be either removed or promote an error - message. Found by Robot101. Added el-cheapo work-around if the - last char of subtopic is |, kill it. - -v0.4a (19990816): - - Added cheap fix (sleep 1, heh) to excess floods of 'topic - history'. Is sleep 1 enough? - - Added 'random' for random value{key} from database. - Requested by jCommons. - -v0.4 (19990815): - - Fixed topic history by replacing push with unshift. Now the - history list is reversed and cycled properly. - - Reversed Changes list. request by mu. - - Totally fixed up topic history since it would break if - 'topic add' was induced quickly. Now we only record topics set - by us (for reasons) and onjoin topics (set by anyone). - - Removed 'topic last/reset' because how do you know which topic - is last? Better control with 'topic restore'. - -v0.3c (19990813): - - Fixed 'topic mv 2 before 1' bug. Forgot to store 'move' topic - before doing the foreach loop. - - Touched up Kernel.pl in preparation for auto-notify feature. - -v0.3b (19990812): - - Added version string to new files so we know which version - of patch we're using (or used). There you go, Mercury ;) - - Fixed up DecipherTopic to reject null subtopics. This would, if - unchanged, (theoretically but not tried, luckily) produce a - domino-effect of problems if the topic was to be changed. - Update: check if the supposed null topic contains spaces - within the nick component. If so, then it's not - nick, therefore treat like ownerless subtopic. - - Worked on README. - -v0.3a (19990810): - - Changed back to use topic{chan} (now topicnow{chan}) since - @topiclist{chan} (now @topichist{chan}) does not deal with dupes - or blanks. - - Renamed 'topic last' in preference to 'topic reset'. Original - command can be used but is vague in meaning. - - Fixed several typos made in Irc.pl. - - Replaced 'defined' with 'length' in if statements. - -v0.3 (19990809): - - Applied patch from mu for Irc.pl | Topic.pl. - - Replaced %topic hash and $topiclast with @{$topiclist{chan}}. - Much cleaner implementation. Thanks to mu for this. Fully - implemented by xk. - - Reworked on topicbyme (was topiclast), should work now. - -v0.2 (19990808): - - Changed name of patch to funkystuph. - - Added history/last/restore to Topic.pl by request of mu and is. - - Reorganised help and order of commands in Topic.pl - - Bot must be addressed to use commands. - - Fixed bug if multiple infobots were in the channel. - - One occurrence where Cipher was called instead of CipherTopic. - - Fixed up Slashdot.pl. Problems: a) borked completely b) missed - first headline. el-cheapo fix but it works. - -v0.1c (19990729): - - Fixed long list{keys|values} bug, hopefully. - - Now randomize key results from search. - - If keys contain ',', underline to differentiate it. - - Fixed possible DoS against Kernel.pl. - - Bug fixed with Kernel.pl repeating itself. - - Typo of @results [one occurrance of @result] - -v0.1b (19990723): - - Fixed bug with &CipherTopic where, if no owner was found, it - would just use NULL. [like "Topic ()"] - - Added kernel feature. - - Moved error messages to public/private, depending on behaviour. - Help-related stuff is private(msg) only for convenience. - -v0.1a (19990721): - - Misc cleanup, removed repeated code. - -v0.1 (19990720): - - Initial release. diff --git a/blootbot/INSTALL b/blootbot/INSTALL deleted file mode 100644 index aed3621..0000000 --- a/blootbot/INSTALL +++ /dev/null @@ -1,28 +0,0 @@ -Method of installation. ------------------------ - -- Copy files/sample/* to files/ - -- Edit files/blootbot.config, modify to taste. -- Edit files/blootbot.servers to modify list of IRC servers to connect. -- Edit files/blootbot.chan to set which channels to join. - -- Install the following Perl modules: - - Net::IRC perl module - - Debian: (apt-get install libnet-irc-perl) - - WWW::Search - - Debian: (apt-get install libwww-search-perl) - - LWP - - Debian: (apt-get install libwww-perl) - - HTML::Parser - - Debian: (apt-get install libhtml-parser-perl) - -- Choose your database: - - MySQL, read INSTALL.mysql (supported) - - SQLite, read INSTALL.sqlite (supported) - - SQLite2, read INSTALL.sqlite (supported) - - PgSQL, read INSTALL.pgsql (unsupported, may work) - -- There are "bugs" in the perl modules. Read INSTALL.patches on how to fix. - -- Finally, './blootbot' diff --git a/blootbot/INSTALL.mysql b/blootbot/INSTALL.mysql deleted file mode 100644 index 5de7a16..0000000 --- a/blootbot/INSTALL.mysql +++ /dev/null @@ -1,39 +0,0 @@ -INSTALL.mysql ----------------- - -- Install a MySQL server and the DBI Perl modules. - - Debian: (apt-get install mysql-server libdbd-mysql-perl) - -- Run 'mysqladmin -u root -p create ' - Where is the same as specified in blootbot.config. - -- Run 'setup/setup.pl' - -= Possible problems - - if connection to localhost is (short) refused, run - '/etc/init.d/mysql stop' - '/etc/init.d/mysql start' - - if connection for user is refused, reload grant tables with - 'mysqladmin -u root -p reload' - -* [OPTIONAL] - - run 'scripts/dbm2mysql.pl old-db' to convert dbm database file - to mysql. - -ADDITIONAL NOTES: ------------------ -You can add a new user manually by connecting to MySQL and performing these -commands: - - $ mysql -u root -p - - mysql> CREATE DATABASE blootbot; - mysql> GRANT USAGE ON *.* TO 'user'@'localhost' IDENTIFIED BY 'yourpassword'; - mysql> GRANT ALL PRIVILEGES ON blootbot.* TO 'user'@'localhost'; - -FULL FACTOID DATABASE: ----------------------- -You can get the data from the MySQL database that the apt bot uses on -#debian at freenode (irc.freenode.net), at: - - http://lain.cheme.cmu.edu/~apt/blootbot/apt.sql.bz2 diff --git a/blootbot/INSTALL.patches b/blootbot/INSTALL.patches deleted file mode 100644 index c72294c..0000000 --- a/blootbot/INSTALL.patches +++ /dev/null @@ -1,16 +0,0 @@ -INSTALL.patches -------------------- - -- apply *.patch patches inside patches/ - - cd /usr/lib/perl5/WWW/Search - patch -p0 < WWW::Search::Google.patch - -- alternatively, move the files from patches/ - - mv patches/Google.pm /usr/lib/perl5/WWW/Search/ - -Net::IRC DCC CHAT ----------------------- -Unfortunately, Net::IRC 0.70 has buggy code that does not detect DCC CHAT -properly. to patch: - cd /usr/share/perl5/Net/IRC/ - cat ~bot/patches/Net_IRC_Connection_pm.patch | patch -p0 diff --git a/blootbot/INSTALL.pgsql b/blootbot/INSTALL.pgsql deleted file mode 100644 index ecab8bc..0000000 --- a/blootbot/INSTALL.pgsql +++ /dev/null @@ -1,39 +0,0 @@ -Method of installation. ------------------------ - -- Debian: (apt-get install postgresql) -- Debian: (apt-get install libpg-perl) - - -As of now, blootbot has full pgsql support. It seems to be working 100%, but it -assumes that you have precreated the database and user for now. As long as you -already created the database and user and stored this info in the blootbot.config, -then the tables will automatically be created on startup. Until I get setup.pl -fixed, run the following commands as root (or postgres if root doesnt have -permission to create users/db's): - -> createuser --no-adduser --no-createdb --pwprompt --encrypted -> createdb --owner= [] - -Dont forget to replace and so forth with actual values you intend to use, -and dont include the <>'s ;) If you run these commands, you should get a user -with an encrypted password that cannot create new db's or user's (as it should be!), -and the user will own the newly created database . Congrats! - -If everything went fine, you should have everything blootbot needs to use pgsql. -Next simply cd to the base directory you installed the bot to and type: - -./blootbot - - -Thats it! Everything the bot needs should be automatically created when it loads -for the first time. - -In the future I will try to get around to editing the setup.pl file to ask the -same questions it does for mysql (your root password etc) so that you can skip -manually creating the database/user. But for now, this should be just fine for -most of you techies out there. - - ----- -troubled@freenode diff --git a/blootbot/INSTALL.sqlite b/blootbot/INSTALL.sqlite deleted file mode 100644 index 35c6b7b..0000000 --- a/blootbot/INSTALL.sqlite +++ /dev/null @@ -1,29 +0,0 @@ -INSTALL.sqlite ----------------- - -SQLite is a C library that implements an embeddable SQL database engine. -Programs that link with the SQLite library can have SQL database access without -running a separate RDBMS process. The distribution comes with a standalone -command-line access program (sqlite) that can be used to administer an SQLite -database and which serves as an example of how to use the SQLite library. - -blootbot will create a file called .sqlite and populate the tables for -you if they do not already exist. - -- Install SQLite libraries and DBI Perl modules. - - Debian: (apt-get install libsqlite0 libdbd-sqlite-perl) - -other distros might need to build from sources. - -You may use either DBD::SQLite or DBD::SQLite2 - -SQLite sources: - -http://www.hwaci.com/sw/sqlite/ - -DBD::SQLite sources: - -http://search.cpan.org/author/MSERGEANT/DBD-SQLite/ - -You will also need the normal Perl DBD stuff which should be included in your -Perl distribution. diff --git a/blootbot/LICENSE b/blootbot/LICENSE deleted file mode 100644 index 5f22124..0000000 --- a/blootbot/LICENSE +++ /dev/null @@ -1,131 +0,0 @@ - - - - - The "Artistic License" - - Preamble - -The intent of this document is to state the conditions under which a -Package may be copied, such that the Copyright Holder maintains some -semblance of artistic control over the development of the package, -while giving the users of the package the right to use and distribute -the Package in a more-or-less customary fashion, plus the right to make -reasonable modifications. - -Definitions: - - "Package" refers to the collection of files distributed by the - Copyright Holder, and derivatives of that collection of files - created through textual modification. - - "Standard Version" refers to such a Package if it has not been - modified, or has been modified in accordance with the wishes - of the Copyright Holder as specified below. - - "Copyright Holder" is whoever is named in the copyright or - copyrights for the package. - - "You" is you, if you're thinking about copying or distributing - this Package. - - "Reasonable copying fee" is whatever you can justify on the - basis of media cost, duplication charges, time of people involved, - and so on. (You will not be required to justify it to the - Copyright Holder, but only to the computing community at large - as a market that must bear the fee.) - - "Freely Available" means that no fee is charged for the item - itself, though there may be fees involved in handling the item. - It also means that recipients of the item may redistribute it - under the same conditions they received it. - -1. You may make and give away verbatim copies of the source form of the -Standard Version of this Package without restriction, provided that you -duplicate all of the original copyright notices and associated disclaimers. - -2. You may apply bug fixes, portability fixes and other modifications -derived from the Public Domain or from the Copyright Holder. A Package -modified in such a way shall still be considered the Standard Version. - -3. You may otherwise modify your copy of this Package in any way, provided -that you insert a prominent notice in each changed file stating how and -when you changed that file, and provided that you do at least ONE of the -following: - - a) place your modifications in the Public Domain or otherwise make them - Freely Available, such as by posting said modifications to Usenet or - an equivalent medium, or placing the modifications on a major archive - site such as uunet.uu.net, or by allowing the Copyright Holder to include - your modifications in the Standard Version of the Package. - - b) use the modified Package only within your corporation or organization. - - c) rename any non-standard executables so the names do not conflict - with standard executables, which must also be provided, and provide - a separate manual page for each non-standard executable that clearly - documents how it differs from the Standard Version. - - d) make other distribution arrangements with the Copyright Holder. - -4. You may distribute the programs of this Package in object code or -executable form, provided that you do at least ONE of the following: - - a) distribute a Standard Version of the executables and library files, - together with instructions (in the manual page or equivalent) on where - to get the Standard Version. - - b) accompany the distribution with the machine-readable source of - the Package with your modifications. - - c) give non-standard executables non-standard names, and clearly - document the differences in manual pages (or equivalent), together - with instructions on where to get the Standard Version. - - d) make other distribution arrangements with the Copyright Holder. - -5. You may charge a reasonable copying fee for any distribution of this -Package. You may charge any fee you choose for support of this -Package. You may not charge a fee for this Package itself. However, -you may distribute this Package in aggregate with other (possibly -commercial) programs as part of a larger (possibly commercial) software -distribution provided that you do not advertise this Package as a -product of your own. You may embed this Package's interpreter within -an executable of yours (by linking); this shall be construed as a mere -form of aggregation, provided that the complete Standard Version of the -interpreter is so embedded. - -6. The scripts and library files supplied as input to or produced as -output from the programs of this Package do not automatically fall -under the copyright of this Package, but belong to whoever generated -them, and may be sold commercially, and may be aggregated with this -Package. If such scripts or library files are aggregated with this -Package via the so-called "undump" or "unexec" methods of producing a -binary executable image, then distribution of such an image shall -neither be construed as a distribution of this Package nor shall it -fall under the restrictions of Paragraphs 3 and 4, provided that you do -not represent such an executable image as a Standard Version of this -Package. - -7. C subroutines (or comparably compiled subroutines in other -languages) supplied by you and linked into this Package in order to -emulate subroutines and variables of the language defined by this -Package shall not be considered part of this Package, but are the -equivalent of input as in Paragraph 6, provided these subroutines do -not change the language in any way that would cause it to fail the -regression tests for the language. - -8. Aggregation of this Package with a commercial distribution is always -permitted provided that the use of this Package is embedded; that is, -when no overt attempt is made to make this Package's interfaces visible -to the end user of the commercial distribution. Such use shall not be -construed as a distribution of this Package. - -9. The name of the Copyright Holder may not be used to endorse or promote -products derived from this software without specific prior written permission. - -10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR -IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED -WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. - - The End diff --git a/blootbot/README b/blootbot/README deleted file mode 100644 index d174102..0000000 --- a/blootbot/README +++ /dev/null @@ -1,155 +0,0 @@ -This is out of date. - - - - - - -blootbot v1.0.0 (20000729) -------------------------- - -INTRODUCTION - This bot is based upon infobot-0.44.2 by kevin lenzo -. The basis of infobot is still there but _many_ wild -features have been added. Along the way, a couple of typos were spotted -in the original infobot source and fixed in this version. Without infobot, -there would be no blootbot so all thanks to kevin for bringing infobot in -the first place. - -FEATURES - * Additional information stored with factoids. (factinfo) - * Wide range of statistics for Bot, Factoids, IRC, Debian. - (status, factstats, ircstats, chanstats, cmdstats) - * Advanced topic management. (the first cool feature) - * Improved factoid search, allowing search by key or value. - * Freshmeat support (freshmeat.net) - * Debian Contents and Packages, search and info. - * ChanServ/NickServ (OPN) support. - * WWW-Search (eg: google for BLAH) - * Slashdot, Kernel and Freshmeat auto-update announcements. - * Units conversion (provided by external module, Units-Module) - - DESIGN - - Modularity. Ability to disable IRC or Factoid support. - - Funky pseudo Module autoloader support - - Eleet Forker() function - -Improvements include: - * log file is not opened and closed for each line of data - => unblocked logging is used. - * seen data is not flushed for each public message on IRC - => caching and flushing over an interval is used. - -HISTORY - As of 0.99pre1, blootbot supports mysql database in the hope to -increase performance and to avoid borked over dbm's which occurred when -the bot crashed (??). The mysql code is far larger (or perhaps twice -as many functions) than expected even though a few functions were needed -for DBM due to lack of table deficiencies. - - As of 1.0.0pre1, blootbot takes advantage of Net::IRC. The -change over was fairly comfortable (95% clean). Just minor problems here -and there, mostly debugging and getting it right. - - As of 1.0.0RC2, the old style DBM (Berkeley) has been ported -back. It should work in all but 3 specific (countdown, factstats unreq) -cases. preliminary pgsql support has been added but someone with pgperl -knowledge needs to fix it up or at least unify the module with mysql. - -INSTALLATION - - Read the included INSTALL file - -NOTICE - Be warned that this bot consumes quite a lot of memory upon start -up and during usage. Right now, 7.4megs is used for old'ish perl, 8.3megs -with perl 5.005. fork() is used but don't be alarmed at the memory usage -as fork(), as I was told, uses COW (copy on write). - - WARNING: enabling wingate support may involve complaints of some -sort, probably because the telnet connection isn't closed properly. -However, these people do not realize the potential of open wingates. - - Please beta test it and report bugs as I have not had the time to -test all modifications properly (and extensively). Suggestions are -welcomed. - - gp@OPN is currently working on a C version of infobot or -blootbot, not based on the above source base. Core factoid code and -mysql support works - but that is it. - -MODIFICATIONS - All modifications are that of the blootbot author unless otherwise -specified, like none. See 'ChangeLog' for details. A list of future -features listed in 'TODO'. - - See 'USAGE' for complete list of commands with description -(FIXME) and examples (FIXME). Yes, it is incomplete. It is better for -you to find the cookies than for me to hand-feed them to you ;) - - See 'EXAMPLES' for various usage of factoids and "hidden" -variables. If you're hardcore, check out 'CommandStubs.pl' and -'UserExtras.pl' for cool features. - - topic [help] - Topic help. - topic add - Append to the current topic. - topic del <#> - Purge topic ID <#> from current topic. - topic list - List broken down summary of current topic. - topic mod s/old/new/ - Modify the topic using regex. - - Now supports , and # as delimiters. - topic mv <1> <2> - : - before - Move <1> before <2> - after - Move <1> after <2> - swap - Swap <1> and <2> - topic shuffle - Jumble the subtopics. - - topic history - Show previous channel topics. - topic restore <#> - Restore channel topic to <#> on history - #list. - -==> Individual commands: NEW - (lobotomy|bequiet) -- [o] silence the bot. - (unlobotomy|benoisy) -- [o] unsilence the bot. - - set -- ... - unset -- ... - - -NOTES - To administrate/control the bot remotely, this can only be done -through DCC CHAT. /chat . All commands must be prepended by -'.' otherwise it is sent to the bot chat net - -### UNTESTED: - - user statistics shown by 'seen'. bug in this? - - User Information Services. - - new wingate caching/file-read code. - - disabling IRC/factoid support code. - - PG supports need to be worked and thoroughly tested. - - -CONTRIBUTIONS - jCommons, is, netgod, mu and Mercury for attempting to break my -modifications, aswell as giving suggestions and ideas in the early -development stages. Bashing of modifications courtesy of larne, irq, lilo -and \broken. - - mu@OPN for the SAR (=~ s///) and Topic history patch. - - someone emailed me a patch to fix up telnet but I accidently -deleted the message together with the patch after replying to the guy. I -hope to get that same guy to re-send me the patch... - - MbM@OPN sent a patch to clean up behaviour of factoids -(adding, removing, modifying). Thanks. - - -CONTACT - Contributions of a patch, or anything, can be sent to - - -Some Documentation is on the website. Please see it for details or -visit: http://sourceforge.net/docman/?group_id=8794 - -IRC - If your looking to hang out on IRC, feel free. We can be found -in the #blootbot channel on irc.freenode.net. See you there! diff --git a/blootbot/README.quick b/blootbot/README.quick deleted file mode 100644 index c17c34d..0000000 --- a/blootbot/README.quick +++ /dev/null @@ -1,14 +0,0 @@ -See INSTALL file on how to install the bot. - -Quick usage instructions: -------------------------- - -DCC CHAT: -.+chan #chan -.chanset #chan +autojoin -.chanset +autojoin -.chanunset -autojoin -.chanset -autojoin - -for list of configuration options, run: - perl scripts/findparam.pl diff --git a/blootbot/TODO b/blootbot/TODO deleted file mode 100644 index c88b2e8..0000000 --- a/blootbot/TODO +++ /dev/null @@ -1,98 +0,0 @@ -TODO: - - Normalize the SQL tables a little better to reduce size and increase speed - - Keep the Changelog, TODO and BUGS files up to date. Clean things up a bit - - rename ^[+-] commands - - remind - like this and others: http://jibble.org/reminderbot/ - - kill SHM and and move to a pipe - - add CIA like support - http://cia.navi.cx/ - - add pastebot like support - http://sial.org/pbot/ - - move nicks/server into sql table - - make channel flags be server/channel flags - - move channel flags to sql table, include initial state - - move praise from blootbot.lang to "praise:" in factoids? - - move lart from blootbot.lang to "lart:" in factoids? - - debian BTS frontend "bugs" - - !country - - !dinstall - - support DCC SEND of factoid (listkeys/listvals) that matched. - - news: show total requested count, users "registered", users - "ignored" - - add notes about news redesign to accomodate individual items - read - need to add id's to each item too. - - bind DCC CHAT service to port. - - man perlipc, search for service. - - do forking aswell. - - debian: "find -2.4.1" does not work but 2.4.1 does? - - $debug var needed. - - check if debian downloading files are proper. - - verbose: say why config option was enabled/enabled. - - registered flags for users/channels - - end of DynaConfig.pl - - use in UserDCC.. warn if value is not in list. - - add &checkSet() or &_chanset(); - - attempt to move userDCC to hooks. - - need to modify parseCmdHooks for user flags? - - make timers below 5 or 10 mins non-random values. - - create a .csv import/export program --- EFFORT 1. - - make IRC/Schedulers.pl work 100%. - - intervals must be multiple of the smallest one otherwise - auto-fixed. - - make intervals chan-specific - - need to store info in $sched{$what}{$chan} = - time(); when last run or next run? - -Other TODO items may be listed on sourceforge. Please access it from the -website or this link: -http://sourceforge.net/pm/task.php?group_id=8794&group_project_id=3207&func=browse&set=open - ----------------------------------------------------- ------------- FUTURE, NON-IMPORTANT - - ~country ua - - xk: add it :) and my imdb feature :) - - xk: and ~bugs :) - - "HACKING" text file, documentation of where things start, - what "core" or reuseable functions are used and what for. - - web interface - - on join message - customizeable, option. - - addon to UserInfo but for channels? - - ^B's are removed (HOW?) from factoids. - - asking questions.... make more guesses - - throttling of "help topic": push-pull system of &msg(). - - use autoloader properly. - - Module:::: - - make a global autoloader. - - support notification of author of deleted factoids, - - flag to hide owner of factoid. - - table data for DCC CHAT or misc table. - - dynamic user//configuration file upgrade: - - finer granuality(sp) of userlist/ignore file - - apt, find netconfig -- merge similar files. - - and same files(1 per package) for multiple packages. - - merge partial similar paths together. - - do some test cases to confirm code actually works as - proposed. - --- useless statistics -- 20010420: -DEBUG: 373 -WARN: 129 -FIXME: 35 -status: 386 -TODO: 145 - -20031111: scripts/output_stats.sh -DEBUG: 384 -WARN: 167 -FIXME: 33 -status: 424 -ERROR: 123 -TODO: 91 - -20050217: scripts/output_stats.sh -DEBUG: 388 -WARN: 164 -FIXME: 43 -status: 436 -ERROR: 125 -TODO: 158 diff --git a/blootbot/blootbot b/blootbot/blootbot deleted file mode 100755 index 4ef62d5..0000000 --- a/blootbot/blootbot +++ /dev/null @@ -1,99 +0,0 @@ -#!/usr/bin/perl - -# infobot -- copyright kevin lenzo (c) 1997-1999 -# blootbot -- copyright david sobon (c) 1999-infinity - -use strict; -use vars qw($bot_base_dir $bot_src_dir $bot_misc_dir $bot_state_dir - $bot_data_dir $bot_config_dir $bot_log_dir $bot_run_dir - $bot_pid $memusage %param -); - -BEGIN { - if (@ARGV and -f $ARGV[0]) { - # source passed config to allow $bot_*_dir to be set. - do $ARGV[0]; - } - - # set any $bot_*_dir var's that aren't already set - $bot_base_dir ||= '.'; - $bot_config_dir ||= 'files/'; - $bot_data_dir ||= 'files/'; - $bot_state_dir ||= 'files/'; - $bot_run_dir ||= '.'; - $bot_src_dir ||= "$bot_base_dir/src"; - $bot_log_dir ||= "$bot_base_dir/log"; - $bot_misc_dir ||= "$bot_base_dir/files"; - - $bot_pid = $$; - - require "$bot_src_dir/logger.pl"; - require "$bot_src_dir/core.pl"; - require "$bot_src_dir/modules.pl"; - - # load the configuration (params) file. - &setupConfig(); - - &showProc(); # to get the first value. - &status("Initial memory usage: $memusage kB"); - &loadCoreModules(); - &loadDBModules(); - &loadFactoidsModules(); - &loadIRCModules(); - - &status("Memory usage after loading modules: $memusage kB"); -} - -# prevent duplicate processes of the same bot -&duperuncheck(); - -# initialize everything -&startup(); # first time initialization. -&setup(); - -if (!&IsParam("Interface") or $param{'Interface'} =~ /IRC/) { - # launch the irc event loop - &ircloop(); -} else { - &cliloop(); -} - -exit 0; # just so you don't look farther down in this file :) - -# --- support routines - -# FIXME: add arguments, basically '-h' and '--help', heh. - -# added by the xk -sub duperuncheck { - my $pid = $$; - my $file = $file{PID}; - - if ( -f $file) { - open(PIDFILE,$file) or die "error: cannot open $file."; - my $thispid = || "NULL\n"; - close PIDFILE; - chop $thispid; - - if ($thispid =~ /^\D$/) { - &staus("warning: pidfile is invalid; wiping out."); - } else { - if ( -d "/proc/$thispid/") { - &ERROR("bot is already running from this directory."); - &ERROR("if this is incorrect, erase '*.pid'."); - &ERROR("verify with 'ps -axu | grep $thispid'."); - exit 1; - } else { - &status("warning: stale $file found; wiping."); - } - } - } - - open(PIDFILE,">$file") or die "error: cannot write to $file."; - print PIDFILE "$pid\n"; - close PIDFILE; - - return 0; -} - -1; diff --git a/blootbot/files/blootbot.help b/blootbot/files/blootbot.help deleted file mode 100644 index e3ee4de..0000000 --- a/blootbot/files/blootbot.help +++ /dev/null @@ -1,485 +0,0 @@ -# Revised: 20050224 -# Author: Tim Riker -### - -main: I learn mainly by observing declarative statements such as "x is at http://www.xxx.com", and then reply when people ask things like "where can i find x?" - -action: This is used to override the usual response. "x is does the hokey-pokey". When asked about x, the bot does this "* blootbot does the hokey-pokey" - -alternation: The || symbol in an entry causes an blootbot to choose one of the replies at random. "X is Y||Z" will produce "X is Y" or "X is Z" randomly. - -author: oznoid (mailto:lenzo@ri.cmu.edu) is my original author. - -dollar variables: D: To be used in factoids -dollar variables: $Fdunno - ... -dollar variables: $Fquestion - ... -dollar variables: $Fupdate - ... -dollar variables: $channel - channel from which the factoid was requested -dollar variables: $date - current date (GMT) -dollar variables: $day - day of week (full name, locale) -dollar variables: $factoids - factoid count -dollar variables: $host - hostname of factoid requester -dollar variables: $ident - bot nick -dollar variables: $lastspeaker - ... -dollar variables: $memusage - ... -dollar variables: $rand - random number, also $rand100.2 -dollar variables: $randnick - random nick -dollar variables: $startTime - start time -dollar variables: $time - current time (GMT) -dollar variables: $uptime - ... -dollar variables: $user - username of factoid requester -dollar variables: $who - nick of factoid requester - -corrections: If I come back with "...but x is at http://xx.xx.xx" or something like that, and you want to change the entry, use "no, x is at http://sdfsdfsdf". The "No," tells me to supercede the existing value. -corrections: you can append stuff to a factoid with "also". "x is also at ..." - -math: D: math expresions can be evaluated. This uses Perl syntax. -math: E: 1+1 -math: + - add -math: - - subtract -math: * - multiply -math: / - division -math: ** - to the power -math: pi - pi -math: & - and -math: | = or -math: ^ - xor - -redirection: If a factoid x contains simply " see y", then when asked for x, I will deliver factoidor command result y instead. - -reply: There is a special tag, , that is used to override the usual response. Usually, a response is "X is Y", but it can be made "Y" by making the entry "X is Y". - -# now the commands... - -adduser: D: Administrative command to add new user to the .users file -adduser: U: ## -adduser: E: ## bloot bloot!bloot@example.com - -addressing: It is a good idea if I stay in REQUIRE mode so that I won't yell out random crap if I listen in too hard. Currently there is no way to turn this off on-the-fly. (REQUIRE mode requires me to be addressed by name if I am to respond) - -babelfish: D: Frontend to babelfish translating service provided by http://babelfish.altavista.com/ Note that utf8 is used for non-ascii characters. -babelfish: U: x -babelfish: U: translate -babelfish: E: x en de your cars rock - --ban: D: FIXME: --ban: U: ## --ban: E: ## *!*@owns.org --ban: E: ## MoronMan - -+ban: D: FIXME: -+ban: U: ## [chan] [time] [reason] -+ban: E: ## *!*@owns.org #bots 60 stop flooding. -+ban: E: ## *!*@*microsoft.com STOOPID -+ban: E: ## MoronMan - -botmail: D: Send someone botmail -botmail: U: ## {for [:] }|stats|check|read -botmail: E: ## for infobot: you rock! -botmail: E: ## stats -botmail: E: ## check -botmail: E: ## read - --chan: D: Leave a channel permanently --chan: U: ## -#channel --chan: E: ## -#botpark - -+chan: D: Join a channel permanently -+chan: U: ## #channel -+chan: E: ## #botpark - -chaninfo: D: Display channel statistics on Op, Ban, Deop, Unban, Part, Join, SignOff, PublicMsg, Kick and Topic -chaninfo: U: ## [#channel] -chaninfo: E: ## -chaninfo: E: ## #botpark - -chanset: D: set a variable for a channel -chanset: U: ## [#chan] [what] [val] -chanset: E: ## #c +test -chanset: E: ## #c -test -chanset: E: ## #c test -chanset: E: ## #c test 0 -chanset: E: ## #c test testing123 - -chanunset: D: remove a variable from a channel -chanunset: U: ## <#chan> [what] -chanunset: E: ## #c -chanunset: E: ## #c test - -chattr: D: Change flags on a user (see "help flags") -chattr: U: ## [flags] -chattr: E: ## bloot +nmo -chattr: E: ## bloot -ot -chattr: E: ## bloot - -chnick: D: rename a nick (user) entry -chnick: U: ## [nick] -chnick: E: ## moron -chnick: E: ## owner eleet - -chpass: D: Change a user's password -chpass: U: ## [user] -chpass: E: ## testing -chpass: E: ## testing test0R - -contents: D: Debian Contents search only (no Packages) -contents: U: ## [dist] -contents: E: ## strings.h -contents: E: ## x11amp potato - -cookie: I can feed your appetite with random factoids. - -cpustats: cpustats dumps the bot's cpu usage this session - -crypt: It's good that you thought about encryption. I can do it for you. -crypt: U: ## -crypt: E: ## 69 changeme -crypt: E: ## $1$abcde changeme - -cycle: D: Causes me to cycle in the channel it's said, or in the named channel -cycle: U: ## [channel] -cycle: E: ## -cycle: E: ## #botpark - -dauthor: D: Find Debian package maintainers, and list the packages they maintain -dauthor: U: ## [dist] -dauthor: E: ## Wichert -dauthor: E: ## Wichert potato - -dbugs: D: Show the current count of release critical bugs (latest versions) -dbugs: U: ## - -deluser: D: Administrative command to remove a user from the .users file -deluser: U: ## -deluser: E: ## bloot - -ddesc: D: Search the Description: lines in Debian packages -ddesc: U: ## [dist] -ddesc: E: ## mule -ddesc: E: ## mule potato - -dfind: D: Debian Packages (fallback to Contents) search -dfind: U: ## [dist] -dfind: E: ## strings.h -dfind: E: ## x11amp potato - -dict: D: DICT Protocol Client - likely dicts: elements web1913 wn gazetteer jargon foldoc easton hitchcock devils world02 vera -dict: U: ## [entry num] [/dict] -dict: E: ## linux -dict: E: ## 33 set/wn - -dns: D: Query DNS -dns: U: ## -dns: E: ## debian.org -dns: E: ## 3.1.33.7 - -do: D: operator command to do things in a channel -do: U: ## - -dstats: D: Show basic stats on the current size of the Debian distros -dstats: U: ## [dist] -dstats: E: ## -dstats: E: ## potato - -factinfo: D: View statistical information about a particular factoid. -factinfo: U: ## -factinfo: E: ## test - -factstats: D: Display statistical data (max of 15) about factoids. -factstats: U: ## -factstats: == author -- top author of factoids. -factstats: == deadredir -- ?? -factstats: == duplicate -- duplicate factoids. -factstats: == listfix -- ?? -factstats: == locked -- locked factoids. -factstats: == new -- recent addition of factoids. -factstats: == nullfactoids -- ?? -factstats: == partdupe -- initial partial duplicate factoids. -factstats: == profanity -- possibly offensive factoids. -factstats: == redir -- redirection in factoids. -factstats: == reqrate -- ?? -factstats: == requested -- most requested factoids. -factstats: == requesters -- most requested factoids. -factstats: == seefix -- ?? -factstats: == toolong -- factoid {key|value} exceeding specified length. -factstats: == tooshort -- factoid {key|value} shorter than specified length. -factstats: == total -- ?? -factstats: == unrequest -- unrequested factoids. -factstats: == vandalism -- ?? -factstats: E: ## new - -forget: If I have an old/redundant factoid x, "forget x" will cause me to erase it. - -freshmeat: D: Frontend to www.freshmeat.net -freshmeat: U: ## -freshmeat: E: ## blootbot - -hex: D: Convert ascii to hex -hex: U: ## -hex: E: ## carrot - -httpdtype: D: Get httpd server software version / configuration -httpdtype: U: ## -httpdtype: E: ## example.com - -ignore: D: ignore list management -ignore: E: ## [mask chan expire comment] -ignore: E: addignore guu!*@* - -ircstats: ircstats dumps some status information on the bot's IRC connection - -join: U: ## <#chan> [key] -join: E: ## #botpark -join: E: ## #botpark rules - -karma: Karma is a community rating system. Use "X++" to increase the karma, or "X--" to decrease it. Ask for ratings using "karma for X?" - -kernel: D: Frontend to linux.kernel.org's finger response. -kernel: U: ## - -kick: U: ## [#chan] [message] -kick: E: ## oznoid -kick: E: ## larne #botpark -kick: E: ## john #foo go away! - -lart: D: Luser Attitude Readjustment Tool -lart: U: ## [#chan] -lart: E: ## lenzo infobot's bugginess -lart: E: ## #perl everyone perl \=\= lamerville - -lc: D: lower case a given string -lc: U: ## -lc: E: ## When will blootbot achieve world domination? - -listauth: D: Search the factoid extension db by creator -listauth: U: ## -listauth: E: ## xk - -listkeys: D: Search the factoid database by key (factoid) -listkeys: U: ## -listkeys: E: ## blootbot - -listvalues: D: Search the factoid database by value (description) -listvalues: U: ## -listvalues: E: ## blootbot - -literal: used to get a raw factoid contents. Use _default to ignore factoidSearch path. -literal: U: ## [_default|prefix] -literal: E: ## blootbot - -lobotomy: I can be given a lobotomy ([o] is required) if people start to abuse me. To bring me back to life, give me an unlobotomy - -lock: D: Factoid locking to prevent removal by others -lock: U: ## -lock: E: ## abuse -lock: N: By default, only registered "ops" on the bots or factoids matching the user's nick are able to lock factoids. -lock: N: Requires factoid extension (extra) support enabled. - -md5: D: calculates the md5sum of a given string -md5: U: ## -md5: E: ## When will blootbot achieve world domination? - -mode: set modes for a channel -mode: U: ## <#chan> -mode: E: ## #botpark +t -mode: E: ## #botpark -i - -news: D: News functions -news: U: ## [chan] - -news add: D: Add news items -news add: U: news [chan] add -news add: E: news add This is a test -news add: see _news set Text_ aswell - -news set: D: Set stuff for news item -news set: U: news [chan] set <item> <what> [value] -news set: valid <what>: Expire, Text -news set: E: news set 1 Text ok, this works -news set: E: news set test Text and this is a test -news set: E: news set test Text - -news set expire: D: Set expire for news item -news set expire: U: news [chan] expire <what> <value> -news set expire: value can be: Xd Xh Xm Xs -news set expire: value can be: never -news set expire: news expire 1 3days -news set expire: news expire 2 +20d -news set expire: news expire Test 30d 20h 10m 5s -news set expire: news expire TEST never - -news del: D: Delete news item (requires +o or be author) -news del: U: news [chan] del <item> -news del: E: news del 1 -news del: E: news del test - -news mod: D: Modify a news item (todo: modify Text aswell) -news mod: E: news [chan] mod <item> s/<from>/<to>/[g] -news mod: E: news mod 1 s/test/Test/ -news mod: E: news mod test s/test/Test/g - -nickometer: D: Measures the lame-ness of a nick or channel -nickometer: U: ## {nick,channel} -nickometer: E: ## unknown_lamer -nickometer: E: ## #botpark - -onjoin: D: get/set OnJoin message (needs chan option +OnJoin) -onjoin: U: ## [#chan|_default] [-]<nick> [message] -onjoin: E: ## blootbot Hey! It's another blootbot! - -ord: D: Convert ascii to decimal -ord: U: ## <single character> -ord: E: ## c - -page: D: Send someone a pager message -page: U: ## <who> <message> -page: E: ## infobot you rock! -page: NOTE: this uses the "<who>'s pager" factoids for the From: and To: addresses of the format "example's pager" is "mailto:me@example.com" - -part: D: Leave a channel (DCC only) -part: U: ## <#channel> -part: E: ## #botpark -part: NOTE: /kick is an alternative - -piglatin: D: translates english text into piglatin -piglatin: U: ## <string> -piglatin: E: ## When will blootbot achieve world domination? - -quote: D: Frontend to yahoo's online stock market share listing -quote: U: ## <query...> -quote: E: ## RHAT,MSFT - -rename: D: Factoid renaming -rename: U: ## 'from' 'to' -rename: E: ## 'infobot' 'blootbot' - -reverse: D: reverses a given string -reverse: U: ## <string> -reverse: E: ## When will blootbot achieve world domination? - -rot13: D: ROT13's a given string -rot13: U: ## <string> -rot13: E: ## guvf vf n ynzr rknzcyr - -say: D: operator command to say things in a channel -say: U: ## <chan> <what> - -scramble: D: scrambles a given string -scramble: U: ## <string> -scramble: E: ## When will blootbot achieve world domination? - -search: U: ## <engine> for <string> -search: E: ## google for blootbot - -seen: D: Report last seen time for somebody -seen: U: ## <nick> -seen: E: ## blootbot - -slashdot: D: News for nerds, Stuff that matters. [tm] (shows the headlines) -slashdot: U: ## - -spell: You've guessed it right, I'm a spell checker. Give me any word and I can confirm whether it's good or bad. - -status: status dumps general status information - -tell: D: Tell someone about a factoid or command -tell: U: ## <who> -?about <what> -tell: E: ## me about blootbot -tell: E: ## someone -about testing - -topic add: D: Add your own topic -topic add: U: ## <topic> -topic add: E: ## This is a test - -topic del: D: Delete one or two subtopics -topic del: U: ## <#> -topic del: E: ## 1 -topic del: E: ## 1-3,5 -topic del: E: ## last - -topic mod: D: Search and replace strings in the topic -topic mod: U: ## <REGEX> -topic mod: E: ## s/test/TEST/ -topic mod: E: ## s#msg test#/msg test#g - -topic mv: D: Move subtopics around. -topic mv: U: ## <#> <before|after|swap> <#> -topic mv: E: ## 1 after 2 -topic mv: E: ## first before last - -topic restore: D: Restores the topic to an earlier version -topic restore: U: ## <#> -topic restore: E: ## 3 - -topic: Usage for 'topic [#chan] <params>': -topic: ---------------- __Subtopic__: -topic: add <TOPIC> - Append <TOPIC> to topic. -topic: del <#> - Remove subtopic <#> from topic. -topic: list - Display subtopics. -topic: mod s/old/new/ - Search and replace topic. -topic: mv <ARGS> - 'topic mv'. -topic: shuffle - Randomly organize subtopics. -topic: ---------------- __Topic__ -topic: history - Show previous topics. -topic: restore <#> - Restore topic to <#>. -topic: rehash - Rehash changes to topic. -topic: info - Who and time info. -topic: ---------------- __Misc__ -topic: about - Read the file :) -topic: help - This screen. - -topic: NOTE: #chan arg is only required if command is sent over private message to nick, otherwise it is not needed if sent to the channel. -topic: NOTE: commands can be preceeded? with '-' in order not to enforce changes to topic. -topic: End of help. - -uc: D: upper case a given string -uc: U: ## <string> -uc: E: ## When will blootbot achieve world domination? - -unforget: If a factoid has been forgotten, "unforget x" will cause me to unerase it. - -unlobotomy: Not possible in real life, an unlobotomy will bring me back to life in the case of a lobotomy. - -unlock: D: Factoid unlocking to allow removal by others. -unlock: U: ## <factoid> -unlock: E: ## abuse - -uptime: D: Show the current uptime, and the top 3 uptimes recorded -uptime: U: ## - -wantnick: If someone's taken my nick (I hope not) and I'm using some temporary nick, I can change back to my original nick if it's not taken (again). - -wikipedia: D: Frontend to the Wikipedia at http://www.wikipedia.org/wiki/ Note that utf8 is used for non-ascii characters. -wikipedia: U: ## <topic> -wikipedia: U: wiki <topic> -wikipedia: E: wiki irc - -wtf: D: Interface to the BSD wtf command -wtf: U: ## <abbreviation> -wtf: E: ## iirc - --host: D: admin command to remove hostmask from a user account --host: U: ## [user] <mask> --host: E: ## *!*@owns.org --host: E: ## owner leet!leet@*.heh.org - -+host: D: admin command to list or add hostmasks to a user account -+host: U: ## [user] [<mask>] -+host: E: ## owner -+host: E: ## *!*@owns.org -+host: E: ## owner leet!leet@*.heh.org - -flags: D: Flags for chattr command -flags: D: "A" - bot administration over /msg (default is only via DCC CHAT) -flags: D: "O" - dynamic ops (as on channel). (automatic +o) -flags: D: "T" - add topics. -flags: D: "a" - ask/request factoid. -flags: D: "m" - modify factoid. (includes renaming) -flags: D: "n" - bot owner, can "reload" -flags: D: "o" - master of bot (automatic +amrt) -flags: D: - can search on factoid strings shorter than 2 chars -flags: D: - can tell bot to join new channels -flags: D: - can [un]lock factoids -flags: D: "r" - remove factoid. -flags: D: "t" - teach/add factoid. - diff --git a/blootbot/files/blootbot.lang b/blootbot/files/blootbot.lang deleted file mode 100644 index 527ea1f..0000000 --- a/blootbot/files/blootbot.lang +++ /dev/null @@ -1,111 +0,0 @@ -# blootbot.lang: configurable responses. -# by the xk. -### - -# Welcome reply: Things to say when people thank me. -welcome - no problem - my pleasure - sure thing - no worries - de nada - de rien - bitte - pas de quoi - gern geschehen - -# Dunno reply (when i recognize a query but can't answer it): -dunno - i don't know - i haven't a clue - no idea - wish i knew - bugger all, i dunno - I give up, what is it? - I don't know, could you explain it? - I'm not sure, is it larger than a breadbox? - parse error: dunno what the heck you're talking about - are you using Windows? - I wish you would RTFM. - have you tried http://www.tldp.org/ ? - KCI error, or a problem with the Keyboard-Chair Interface. - -# moron reply. -moron - You think I'm human? Think again! - h0 h0 h0 - Hi, how's life? - What do you want? - Are you on drugs? - Wassup G? - -# confuse/refuse learn. -confused - I think you lost me on that one - what are you talking about? - -# Hello reply (ways to say hello): -hello - hello - hi - hey - niihau - bonjour - hola - salut - que tal - privet - what's up - moin moin - -# Cookie reply: added by the xk. -cookie - ACTION spins the wheel of knowledge and ponders... ##KEY... ##VALUE - ACTION pulls out the cookie jar and finds ##KEY... ##VALUE - Hey ##WHO, ##KEY is ##VALUE - -# Factoid reply: -factoid - methinks ##KEY is ##VALUE - i heard ##KEY is ##VALUE - i guess ##KEY is ##VALUE - from memory, ##KEY is ##VALUE - hmm... ##KEY is ##VALUE - ##KEY is probably ##VALUE - ##KEY is, like, ##VALUE - rumour has it, ##KEY is ##VALUE - it has been said that ##KEY is ##VALUE - somebody said ##KEY was ##VALUE - well, ##KEY is ##VALUE - extra, extra, read all about it, ##KEY is ##VALUE - [##KEY] ##VALUE - -# HowAreYou reply: -howareyou - eh, ok - peachy - just great - you know how it is... - pretty good. how about you? - mas o menos - -# Question word. -qWord - who - who is - who are - what - what's - what is - what are - where - where's - where is - where are - -# botsnack etc praise -# TODO add ACTION support -praise - :) - thanks - aw, gee diff --git a/blootbot/files/blootbot.lart b/blootbot/files/blootbot.lart deleted file mode 100644 index 69e0478..0000000 --- a/blootbot/files/blootbot.lart +++ /dev/null @@ -1,131 +0,0 @@ - -# -# lart info by ejb (larne) and cerb. -# - ---purges WHO -accelerates a free AOL cd to 50,000 rpm and lets WHO feel it -acting on orders from an unspecified client drags WHO into court suing for $200 million -beats the living hamstercrap out of WHO -beats WHO into protomatter with the andromeda galaxy -beats WHO over the head with a microkernel -beats WHO senseless with a 50lb Unix manual -beats WHO severely about the head and shoulders with a rubber chicken -beats WHO to within 2.54cm of his life -blames WHO for all the evil in the world -blasts WHO to oblivion with a kamehameha wave -blasts WHO with a huge firehose then strangles WHO with it -brandishes Excalibur! "With this sword, I vanquish thee, WHO!" and lops off WHO's head -breaks out the Hoover and sucks up WHO -burns WHO to a crisp with a laser -calls WHO on the phone ... the lights are on but nobody's home -cats /dev/urandom into WHO's ear -changes WHO's permissions to 0777 and tells the world -chops WHO in half with a free AOL CD -chops WHO in half with a free Solaris 7 CD -crushes WHO with a full height scsi disk -cuts off WHO's head with a halberd that could have been a little bit sharper -cuts WHO into thin stripes -decapitates WHO conan the destroyer style -declares WHO a moron -does a little 'dpkg -P WHO' action -does a little 'renice 20 -u WHO' -DoSes WHO -drops a baby grand on WHO -drops a humongous exploding nuke on WHO -drops a truckload of VAXen on WHO -duct-tapes WHO to the floor and drools on him -dumps 42 tons of dirt, manure, and fish heads on WHO -eats WHO and falls over dead -eats WHO's liver with some fava beans and a nice chianti -executes killall -HUP WHO -executes killall -KILL WHO -executes killall -TERM WHO -explains, ever so gently, that if WHO doesn't give the channel more information, they can't help -farts in WHO's general direction -flings poo at WHO -follow's WHO with a gauntlet and ... scratch ... HUMILIATION -forces WHO to use Outlook Express -frags WHO with his BFG9000 -gets a hotmal account and SPAMs WHO -gives WHO a "free" copy of Windows and then charges double for "Upgrades" -gives WHO a good seeing to -gives WHO an extra strength ACME sleeping pill, sending WHO to sleep for 150 years, and awakening to seven strange dwarfs and a large apple -grabs a large, mis-shapened log, with squirrels, and beats WHO until only the nuts remain ... which the squirrels run off with -hauls WHO up by the scruff of the neck and spanks him until he waddles -hereby declares WHO a troll -hits WHO with an anvil and laughs with a contralto voice ... Haha Ha HA Ha -holds WHO to the floor and spanks him with a cat-o-nine-tails -hooks into a hydrant and hoses WHO down -hurls dozens of incontinent, insomniac, hungry kittens with tiny little razor-sharp claws and a wide variety of contagious intestinal parasites at WHO -installs a bad bootloader on WHO and turns WHO into a brick -installs PocketPC on WHO's PDA -judo chops WHO -keeps mailing WHO free America Online CDs until he drowns -lowers WHO's priority -makes a balloon animal out of WHO -moos at WHO -nabs the moon and broadsides WHO with the sea of tranquility -nukes WHO with a single large nuke -offers WHO some herring -overclocks WHO until WHO burns out -plops WHO into a giant vat of herring -pours gasoline all over WHO, ignites the fire, and then enjoys some toasty marshmallows with the glorious blaze -pours hot grits down the front of WHO's pants -pries WHO's back open with a screwdriver and flashes a new bootldr to WHO -pulls out a ClueBat (tm) and thwaps WHO -pulls out his louisville slugger and uses WHO's head to break the homerun record -pushes the wall down onto WHO whilst whistling innocently -puts on a hockey mask and jumps out at WHO -puts on some milking gloves. "All right, now, WHO, this won't hurt a bit...." -puts WHO into a headlock and administers a mighty noogie, rubbing half of WHO's hair of -puts WHO through a wood chipper -raises middle finger to WHO -readies the nuke launcher and fires some rounds at WHO -resizes WHO's terminal to 40x24 -rm -rf's WHO -runs at WHO with an origami Swiss Army knife, and inflicts a nasty paper cut -says "boot to the head" and knocks WHO over -send killer squirrels to attack WHO -sends a legion of lawyers after WHO's head -shoots WHO in his sleep -shoots WHO in the head -shoves a crumpet down WHO's throat, happy now?! Huh? Want some JAM with that? -slams WHO against a large cement Tux -slaps a compatible dib on WHO's head -slaps WHO around with a large trout -slaps WHO upside and over the head with one freakishly huge killer whale named hugh -slaps WHO upside the head with a wet fish -smacks WHO up side the head with a clue-by-4 -squeezes WHO till WHO turns blue like papa smurf -squishes WHO like a bug -stabs WHO -stamps WHO on the forehead with the official Troll marker -steals WHO's mojo -strangles WHO with a 9-pole serial cable -strangles WHO with a doohicky mouse cord -stuffs WHO into a shiny new tin can and vacuum seals it -takes a big bite out of WHO's jugular vein -takes a large goose feather pillow and swings it wildly in WHO's direction, hitting WHO and sending WHO flying into the closet -takes a rusty axe and swings it violently, taking WHO's head off -takes large quantities of Krispy Kream donuts and stuffs them one after another down WHO's throat until WHO puts on 150lbs -takes out a cattle prod and gives WHO a good jolt -takes out a seltzer bottle and sprays WHO in the face. You know, one of those old-school seltzer bottles clowns have? Yeah those. Anyway, consider yourself spritzed -takes out WHO with the trash -takes WHO to the vet for a "special" visit -teaches WHO that M$ Access is a database. No, really, a database. A real live multi-user... well, ok, not multi-user, but a database. Yeah, that sounds right. -teaches WHO the basics, including how to RTM -throws a AN/M-8 smoke grenade at WHO -throws WHO's poor little doggy off a cliff -tries to shut WHO up -turns WHO into a lifesized tux doll -urinates on WHO -wallops WHO with a main rotation server that needs rehubbing. It won't take long -whacks WHO upside the head -whacks WHO with a giant beaver's tail -whacks WHO with the cluebat -whips out a hot clue gun and makes sure that WHO is stuck to the floor -whips out a shotgun, trudges over to WHO, and goes postal -whips out a sword and chops WHO in half -whips out his power stapler and staples WHO's foot to the floor -whips WHO with a wet and grimy noodle just because diff --git a/blootbot/files/blootbot.randtext b/blootbot/files/blootbot.randtext deleted file mode 100644 index 817a01e..0000000 --- a/blootbot/files/blootbot.randtext +++ /dev/null @@ -1,2104 +0,0 @@ -He who controls the source controls the universe! -Want to see a listing of files installed by a package, type dpkg -L package -Need to know the status of a package? type dpkg -s package -Need help, but everyone is idle in the channel, try emailing to debian-user@lists.debian.org -Need to see the list of packages matching a pattern, type dpkg -l pattern -If you have a webserver and dww packages installed, try http://localhost/dwww for all kinds of documentation -Need help setting up PPP? read /usr/doc/ppp/README.debian -Want to know why Debian is best? type !why in the channel -Want to upgrade to hamm (unstable)? type !libc6 to get the mini-HOWTO -Want to check out Debian social contract? type !dfsg in the channel -Warning: Dates in Calendar are closer than they appear. -Daddy, why doesn't this magnet pick up this floppy disk? -Give me ambiguity or give me something else. -I.R.S.: We've got what it takes to take what you've got! -We are born naked, wet and hungry. Then things get worse. -Pentiums melt in your PC, not in your hand. -Suicidal twin kills sister by mistake! -Did anyone see my lost carrier? -Make it idiot proof and someone will make a better idiot. -I'm not a complete idiot, some parts are missing! -He who laughs last thinks slowest! -Always remember you're unique, just like everyone else. -'More hay, Trigger?' 'No thanks, Roy, I'm stuffed!' -A flashlight is a case for holding dead batteries. -Lottery: A tax on people who are bad at math. -There's too much blood in my caffeine system. -Artificial Intelligence usually beats real stupidity. -Hard work has a future payoff. Laziness pays off now. -Friends help you move. Real friends help you move bodies. -I won't rise to the occaasion, but I'll slide over to it. -Ever notice how fast Windows runs? Neither did I. -Double your drive space - delete Windows! -What is a 'free' gift ? Aren't all gifts free? -If ignorance is bliss, you must be orgasmic. -'Very funny, Scotty. Now beam down my clothes.' -Puritanism: The haunting fear that someone, somewhere may be happy. -Consciousness: that annoying time between naps. -Oops. My brain just hit a bad sector. -I used to have a handle on life, then it broke. -Don't take life too seriously, you won't get out alive. -I don't suffer from insanity. I enjoy every minute of it. -Better to understand a little than to misunderstand a lot. -The gene pool could use a little chlorine. -When there's a will, I want to be in it. -Okay, who put a 'stop payment' on my reality check? -Few women admit their age. Few men act theirs. -I'm as confused as a baby in a topless bar. -We have enough youth, how about a fountain of SMART? -All generalizations are false, including this one. -Change is inevitable, except from a vending machine. -C program run. C program crash. C programmer quit. -'Criminal Lawyer' is a redundancy. -Clap on! (clap, clap) Clap off! (clap@#&$NO CARRIER -'640K ought to be enough for anybody.' Bill Gates '81 -'90% of all statistics are made up' -'A fanatic is one who can't change his mind and won't change the subject.' -'A little work, a little sleep, a little love and it is all over.' - R. Frost -'A lot of people mistake a short memory for a clear conscience.' -Doug Larson -'Apple' (c) 6024 b.c., Adam & Eve -'Apple' (c) Copyright 1767, Sir Isaac Newton. -'Bad knee, gotta run' - Pat Buchanan to his draft board -'Beam me aboard, Scotty.' 'Sure. Will a 2x10 do?' -'Beulah, peel me a grape.' -'Bother,' said Pooh as the brakes went out! -'Build a watch in 179 easy steps' by C. Forsberg. -'C++' should have been called 'D' -'COINCIDENCE' happens. -'Calvin, we will not have an anatomically correct snowman!' -'Careful. We don't want to learn from this.' -- Calvin -'Don't you hate it when your boogers freeze?' -- Calvin -'Every time I've built character, I've regretted it.' -'Freedom defined is freedom denied.' -The Illuminatus -'Have you ever dated somebody because you were too lazy to commit suicide?' -'Hi-ho, hi-ho, it's hand grenades I throw...' -'Hmm... How *did* they finally kill Frosty?' -- Hobbes -'Human equality is a contingent fact of history.' -Steven Jay Gould -'I tried to think but nothing happened!' - Curly -'I'm not an actor, but I play one on TV' -'I'm not smart enough to lie' - Ronald Reagan -'If I knew what I was doing...I'd be dangerous...' -'If the shoe fits, buy it.' Imelda Marcos -'Instant gratification takes too long.' - Carrie Fisher -'Is' is the verb for when you don't want a verb. -'It is not the fall that kills you. it's the sudden stop at the end.'-D. Adams -'It's sad how whole families are torn apart by simple things, like wild dogs' -'Keyboard? How quaint!' - Scotty -'Luke... Luke... Use the MOUSE, Luke' - Obi Wan Gates -'Mr. Worf, blow the Windows-powered Borg ship out of this Universe!' -'Off the keyboard, thru the router, over the bridge, nothing but net!' -'Quotations are for people who are not saying things worth quoting.' -'Remember when we said there was no future? Well, this is it.' -- Blank Regk -'Stupid' is a boundless concept. -'Suicide Hotline...please hold.' -'The faster you go, the shorter you are' - Einstein -'The reports of my death have been greatly exaggerated.' - Mark Twain -'The sun ain't yellow, its chicken.' -Bob Dylan -'There are lies, damned lies, and statistics.' -Mark Twain -'There's someone in my head, but its not me.' -Pink Floyd -'This is a job for.. AACK! WAAUGHHH!! ...someone else.' - -'To err is human, to forgive....$5.00' -'Ummm, Trouble with grammar have I! Yes!' -Yoda- -'Vote for Perot' - Bumper sticker attached with Velcro -'You can't have everything. Where would you put it?' -Steven Wright -#1 OS/2 tip: Drag the Windows folder to the shreader!!! -#include std/disclaimer.h -$$$ not found -- (A)bort (R)efinance (B)ankrupt -'Tis better to be thought a fool, then to open your mouth and remove all doubt -(((((This tagline in Stereo where available))))) -(A)bort (R)etry (C)ut Your Throat..... -(A)bort (R)etry (F)ail (U)nplug & (S)ell. -(A)bort (R)etry (P)ull leg (H)ot boot (S)wipe tagline! -(A)bort, (R)etry, (I)nfluence with large hammer -(A)bort, (R)etry, (P)retend this never happened... -(D)inner not ready: (A)bort (R)etry (P)izza -(You can have your cake) XOR (You can eat your cake) -(c) Copywight 1995 Elmer Fudd. All wights wesewved. -* OLX 3 * Windows is to OS/2 what Etch-a-Sketch is to art. -*Four hours* to bury a cat? Yes - it wouldn't keep still -.. Bugs come in through open Windows. -... 'I'll be Bach.' - Johann Sebastian Schwarzenegger -... All the world's a stage, and I missed rehearsal. -... Bill Clinton isn't slick. He's just a liar. -... Clinton Economics: If 1+2=3 then 4+5=6. -... Clinton excuse #15: Hey - I just do what the wife says -... Clinton excuse #18: You took that seriously? Har har -... Clinton sandwich: $5 of baloney and $20 in taxes -... Getting the truth from Clinton is like nailing Jello -... It's tourist season in Florida, bag limit two. -... KARAOKE is Japanese for 'Tone Deaf' -... Some days you're the dog, some days you're the hydrant -.....If it ain't broke, fix it anyway just to screw it up! -...I'm sorry, Reality is not in service at this time. -...On the other hand, you have different fingers. -..Windows NT Performance', on the next 'In Search Of' -/EARTH is 98% full. Please delete anybody you can -1 + 1 = ? Ask my calculator. -10 out of 5 doctors feel it's OK to be schitzo! -1200 bps used to seem so fast -186,000 miles/sec: Not just a good idea, it's the LAW. -1st rule of intelligent tinkering - save all the parts -2 + 2 = 4 (for the time being). -2 + 2 = 5 (for sufficiently large values of 2) -3 out of 4 Americans make up 75% of the population. -43% of all statistics are worthless. -43rd Law of Computing: Anything that can go wr... -5 schizophrenics agree! -50 states, and I had to pick this one... -668 - Neighbor of the Beast -90% of being smart is knowing what you're dumb at. -<<< Tagline deleted by Natl Endowment for the Arts >>> -==/==/==/==Police tagline==/==/==Do not cross ==/==/==/== -From my brain, an organ with a mind of it's own. -From the Department of Redundancy Dept. -A BBSer's telephone bill knows no bounds... -A Bugless Program is an Abstract Theoretical Concept. -A Metaphor is like a Simile. -A Smith & Wesson *ALWAYS* beats 4 Aces. -A big enough hammer fixes anything -A bird in the hand can be messy. -A camel is a horse planned by committee. -A chicken is an egg's way of producing more eggs. -A clean desk is a sign of a cluttered desk drawer. -A closed mind gathers no intelligence -A closed mouth gathers no feet. -A committee has 6 or more legs and no brain. -A conscience does not prevent sin. It only prevents you from enjoying it. -A critic is a man who leaves no turn unstoned. -A cynic smells flowers and looks for the casket. -A day for firm decisions! Or is it? -A day not wasted is a day wasted! -A day without radiation is a day without sunshine. -A day without sunshine is like night. -A diplomat thinks twice before saying nothing. -A dirty book is rarely dusty. -A fool and his money are soon SYSOP. -A fool and his money rarely get together to start with. -A fool must now and then be right by chance. -A friend in need is a pest indeed... -A friend: someone who likes you even after they know you. -A good way to deal with predators is to taste terrible. -A half moon is better than no moon at all. -A harp is a nude piano. -A hunch is creativity trying to tell you something. -A library is an arsenal of liberty. -A life lived in fear is half a life lived. -A little greed can get you lots of stuff. -A little inaccuracy sometimes saves tons of explanation. -A living example of Artificial Intelligence. -A man needs a good memory after he has lied. -A man's best friend is his dogma. -A man, a plan, a canal. Suez! -A mind is a terrible thing to taste. -A mind is a terrible thing to ugg.. I forgot.. -A neat desk is a sign of a sick mind. -A pedestrian hit me and went under my car. -A penny saved is a Governmental oversight. -A perversion of nature....how exciting! -A pessimist is never disappointed. -A phaser on stun is like a day without orange juice. -A rolling stone gathers momentum. -A seminar on Time Travel will be held two weeks ago. -A single fact can spoil a good argument. -A stitch in time would have confused Einstein. -A truly wise man never plays leapfrog with a moose. -A waist is a terrible thing to mind. -A yer ago I kudnt spel progremr now I are won. -ASCII and ye shall receive. -ASCII stupid question... get a stupid ANSI! -Abandon all hope ye who have entered cyberspace. -Afraid of heights? Not me, I'm afraid of widths! -Agnodyslexic plea: 'why ME, dog?' -Air conditioned environment - Do not open Windows. -Alex, I'll take 'Things Only I Know' for $1000. -All E-mail gladly received. Offensive reply ASAP. -All I ask for is the opportunity to prove that money can't make me happy. -All I need to know I learned from my cat. -All I want is a warm bed, a kind word and unlimited power -All generalizations are bad. -All generalizations are false, including this one. -All hope abandon, ye who enter messages here. -All in a day's work for...'Confuse-a-Cat'! -All in all it's just a... 'nother brick in the wall! -All life's answers are on TV. - Bart Simpson -All programers are optimists. -All that glitters has a high refractive index. -All the easy problems have been solved. -All things are green unless they are not. -All wiyht. Rho sritched mg kegtops awound? -All words are pegs on which to hang ideas. -All work and no play, will make you a manager. -All you need to be a fisherman is patience and bait. -Almost went crazy. Would have been a real short trip. -Alone: In bad company. -Always draw your curves, then plot the data. -Always forgive your enemies, nothing annoys them so much. -Always glad to share my ignorance - I've got plenty. -Always proofread carefully to see if you any words out. -Always remember no matter where you go, there you are. -Alzheimers advantage: New friends every day. -Ambition is the last refuge of the failure. -America Good Place to Put Chinese Restaurant. -Amusement is the happiness of those who cannot think. -An Elephant; A Mouse built to government specifications. -An egotist thinks he's in the groove when he's really in a rut. -An elephant is a mouse with an operating system. -An idle mind is worth two in the bush. -An ounce of application is worth a ton of abstraction. -An ounce of emotion is equal to a ton of facts. -An oyster is a fish built like a nut. -An ulcer is what you get mountain climbing over molehills. -An unbreakable toy is useful for breaking other toys. -An unemployed court jester is no one's fool. -And don't start a sentence with a conjunction. -And he disappeared in a puff of logic. -And if one bad cluster should accidentally fail... -And it's only ones and zeros. -And now for something completely different... -And now for something completely the same... -And tomorrow will be like today, only more so. -And, the driver compresses EVERYTHING, not just EXE & COM -Angels can fly because they take themselves so lightly. -Anger blows out the lamp of the mind. -Another case of Cherry Coke down the programming hatch! -Answers: $1 * Correct answers: $5 * Dumb looks: Free! * -Antidisestablishmentarianism! -Any closet is a walk-in closet if you try hard enough. -Any fool can criticize, condemn, & complain. And most do. -Any philosophy that can be put in a nutshell belongs there -Any wire cut to length will be too short. -Anything worth doing, is worth doing for a profit. -Are we having Fahrvergnugen yet?? -Are ya feelin' lucky, punk?!! - Harry Callahan -Are you really American if your ethnicity has to be hyphenated? -Are you suggesting that coconuts migrate? -Armageddon means never having to say you're sorry. -Artificial Intelligence is no match for natural stupidity. -As I said before, I never repeat myself. -As a matter of fact, no, I don't have a life. -As easy as 3.14159265358979323846264338327950288419716 -As long as I can remember, I've had amnesia. -Ask not for whom the bell tolls; let the machine get it. -Assumption is the mother of all screwups... -Atheist = Deity Disadvantaged. -Auntie Em: Hate you, hate Kansas, taking the dog. -Dorothy -B.Gates : quality software :: R.McDonald : gourmet cuisine -BREAKFAST.COM Halted... Cereal Port Not Responding. -Back Up My Hard Drive? I Can't Find The Reverse Switch! -Backup not found: (A)bort (R)etry (P)anic -Bad Command:(A)bort (R)etry (T)ake RAM hostage -Bad breath is better than no breath. -Bald: follicularly challenged. -Barium: what you do with dead chemists. -Beautify Texas. Put a Yankee on a bus. -Been there, done that, got the T-shirt. -Best file compressor around: DEL *.* (100% compression!) -Best way to dispose of the Borg: Give them Windows 3.1. -Better ... stronger ... faster! -Beware of Geeks bearing gifs. -Beware of barking dogs that bite. -Beware of programmers carrying screwdrivers -Bigamy : one wife too many. Monogamy : same thing -Bill Clinton is the Lyin' King. ( Now playing nation wide ) -Bill Clinton thinks that Cheerios are donut seeds. -Bill Clintoon: The prince of Dorkness, a caricature of a president -Black Holes are Out of Sight -Black holes really suck... -Blessed are the pessimists, for they make backups! -Blessed is the end-user who expects nothing, for ye shall not be dissapointed. -Bliss *IS* ignorance -Bo Knows Taglines! -Bo Peep did it for the insurance. -Bombs don't kill people, explosions kill people. -Borderline psychotic with hermit-like tendencies. -Bore: A person who talks when you wish him to listen. -Bored? Drive the speed limit... in your garage. -Borg spreadsheet: Locutus 1-2-3 -Borg? Where? I don't se*(#$#..NO CARRIER -Both of his feet are firmly planted in the air. -Boy: A noise with dirt on it. -Brain dysfunction detected.... -Brain over - Insert coin -Brain: The apparatus with which we think that we think. -Break up a relationship - buy a computer!! -Breathing may be hazardous to your health. -Britannia waives the rules. -Bug off, Banana Nose; Relieve mine eyes -Bugs are Sons of Glitches! -Bugs, like coathangers, breed if unobserved. -Building Contractors, not to be confused with homemakers -Bullets speak louder than reason. -Bumper sticker on a hearse: I'd rather be breathing -Bungee Jumper? Catch you on the rebound. -Bureaucrats cut red tape, lengthwise -Bus error (Passengers dumped) -Busier than a 1 legged man in an butt-kicking contest. -But I forgot all about the Amnesia Conference!! -But honey, we can afford it, I sold your car! -But my little voice TOLD me to do it! -But soft, what light through yonder tagline breaks? -But then again, I like cold toilet seats. -But what if I'm a figment of my OWN imagination? -Buy American! -Buy Land Now. It's Not Being Made Any More. -Buy a supscription to Playboy and send it to your boss' wife -By all means, let's not confuse ourselves with the facts! -C programmer run C programmer crash C programmer quit -C:\DOS C:\DOS\RUN RUN DOS RUN -CAUTION: RIDER MAY BAIL AT ANY TIME -CCITT: Can't Certify I Trust Telecom. -CCITT: Can't Conceive Intelligent Thoughts Today -CD-WOM, Wead Onwy Memowy. -CEO of Dementia and Other Meaningless Entities. -CHIP: One California hi-way patrolman. -CODING: AN addictive Drug. -COMMAND: A suggestion made to a computer. -CONgress (n) - Opposite of PROgress -CRASH: Normal termination. -CRIME CONTROL: Fire a warning shot into his HEART! -CURIOSITY? Nah. I got THAT cat with a lawnmower. -CYCLIC REDUNDANCY CHECK: Stocktaking at a Bike shop -California raisins murdered: Cereal Killer suspected -Can I yell 'movie' in a crowded firehouse? -Can you find the mispelled word in hear? -Can you repeat the part after 'Listen very carefully'? -Can you see the REAL ME, can ya?!?! CAN YA??!?!!?!?!?!?! -Can you tell me how to get to Sesame Street? -Can't learn to do it well? Learn to enjoy doing it badly! -Card-carrying member of the cultural elite. -Carlsbad Caverns: 22% more cavities. -Cause of crash: Inadvertent contact with the ground. -Caution: Breathing may be hazardous to your health. -Caution: Contents under pressure -Caution: Hungry Dieter May bite if provoked -Caveat emptor, no deposit no return, do not remove. -Celibacy is not hereditary. -Cheer up, the worst is yet to come. -Chernobyl used Windows -Chess players mate better. -Chicago runs best on a VCR. -Chicago, an operating system Pair-of-Dimes shift! -Chicago... The biggest thing since New Coke! -Chicago: NT deja vu! -Chicago? Been there. I'm ready to travel at WARP speed! -Chicken heads are the chief food of captive alligators. -Chipmunks roasting on an open fire. -Choose heaven for climate, hell for society. -Christmas comes, but once a year is enough. -Circular Definition: see Definition, Circular. -City Planners do it with their eyes shut. -Civilization - biggest syntax error in history! -Clark Kent is a transvestite. -Clarvoiants meeting canceled due to unforseen events. -Clean mind, clean body: take your pick. -Cleanliness is next to impossible. -Climate is what you expect. Weather is what you get. -Clinton is one Bill, George Bush can't veto... -Clinton/Gore is to the presidency as Beavis & Butthead are to television. -Clones are people two. -Close only counts in horseshoes and hand grenades! -Close your eyes and press escape three times. -Closed Hearing for the Caption Impaired... -Cogito ergo spud I think therefore I yam. -Cole's Law: Thinly sliced cabbage. -Come in here, dear boy, have a cigar, you're gonna go far! -Coming Soon!! Mouse Support for Edlin! -Coming soon: Netware for the Nintendo! -Commence strategic maneuvers at audible command signal. 5, 4, 3... -Committees keep minutes and lose hours. -Common sense is the collection of prejudices acquired by age eighteen. -Common sense isn't... -Communism is like a mouth on a lollipop -Competence always contains the seeds of incompetence. -Computational Physicist and all around nice guy. -Computer Lie #1: You'll never use all that disk space. -Computer: a million morons working at the speed of light. -Computers All Wait at the Same Speed! -Computers Rule 01001111 01001011 -Computers are not intelligent. They only think they are. -Computers are useless; they can only give answers. -Computers run on faith, not electrons. -Condense soup, not books! -Conformity obstructs progress. -Confucius say too much. -Confucius say: I didn't say that! -Confucius say: Man with no legs bums around. -Confucius say: Those who quote me are fools. -Confuse People: Quote from the wrong message! -Confused? Call Counselor Troi 1-900-NCC-1701: $1.95/minute -Confusion not only reigns, it pours. -Consolations, Consultations, Conflagrations. -Constant change is here to stay. -Contentsoftaglinemaysettleduringshipping. -Converse with any plankton lately? -Copyright the Intergalactic Thought Association -Corrupt REALITY.SYS: Reboot Universe (Y/n)? -Could crop circles be the work of a cereal killer? -Couldn't myself have better it said. -Courage atrophies from lack of use. -Crime does not pay...as well as politics. -Crime doesn't pay... does that mean my job is a crime? -Crime wouldn't pay if the government ran it. -Crime, Sex, Alcohol, Drugs...Boy do I love Congress -Cynicism is intellectual dandyism. -Cynics are people who know the price of everything and the value of nothing. -D.A.D.D. - Daddies Against Dirty Diapers -D.A.M. - Mothers Against Dyslexia -D.A.M.M - Drunks Against Mad Mothers -DAM: Mothers Against Dyslexia. -DANGER! Computer store ahead, hide wallet! -DCE seeks DTE for mutual exchange of data. -DEFINE: De ting you get for breaking de law. -DEVICE=EXXON.SYS may mess up your environment -DILATE: To live longer. -DIODE: What happens to people who don't die young. -DIVORCE =system('echo y| erase \wife\*.*' ); -DO NOT ADJUST YOUR MIND - the fault is with reality -DO NOT REMOVE THIS TAGLINE (UNDER PENALTY OF LAW)! -DOC files? We don't need NO STINKIN' DOC FILES! -DOS 5.0 Yesterday's operating system, today! -DOS means never having to live hand-to-mouse. -DOS never says 'EXCELLENT command or filename, Dude!' -DOS-O-MANIA : Reboot is not kicking your computer again -DOS-O-MANIA : Root is not the book Alex Haley wrote. -DOWN WITH EXCLAMATION POINTS!!!! -Daddy, what does 'Formatting Drive C:' mean? -Dain Bramaged. -Dang this hobby is expensive! -Dangerous exercise: Jumping to conclusions. -Darth Vader sleeps with a Teddywookie. -Dawn: The time when men of reason go to bed. -Dawson's First Law: You don't have enough outlets. -Death benefits = oxymoron. -Death is 99 per cent fatal to laboratory rats. -Death is God's way of dropping carrier. -Death is life's answer to the question 'Why?' -Death is life's way of telling you you've been fired. -Death sneaks up on you as a windshield sneaks up on a bug. -Death: to stop sinning suddenly. -Deflector shields just came on, Captain. -Delivered by Electronic Sled-Dogs.....Woof! -Democrats Call for Amnesty, Reduced Sentences Likely. -Depart in pieces.... i.e., Split. -Detour: The roughest distance between two points. -Diagonally parked in a parallel universe. -Did I just step on someone's toes again? -Did ya hear? They took the word gullible out of the dictionary! -Did you expect mere proof to sway my opinion? -Die Yuppie Scum. -Diets are for those who are thick and tired of it. -Difference between Jane Fonda & Bill Clinton? Jane went to Vietnam -Digression is education. -Dime: a dollar with all the taxes taken out. -Dinner Not Ready...(A)bort (R)etry (P)izza -Diplomacy is saying 'nice doggy' until you find a rock. -Diplomacy is the ability to let someone else have your way. -Diplomacy: The patriotic art of lying for one's country. -Dirty deeds - DONE DIRT CHEAP! -Disclaimer: All opinions are not really opinions. -Disclaimer: Written by a highly caffeinated mammal. -Discoveries are made by not following instructions. -Disks travel in packs. -Dyslexics of the world, UNTIE! -Do Androids Dream of Electric Sheep? -Do I mind if you smoke? No. Do you mind if I FART? -Do fish get thirsty? -Do not believe in miracles -- rely on them. -Do not disturb. Already disturbed! -Do not put statements in the negative form. -Do radioactive cats have 18 half-lives? -Do steam rollers really roll steam? -Do the joke. Get the laugh. Move on. -Do unto others BEFORE they do unto you! -Do vegetarians eat animal crackers? -Do you know the way to San Jose? -Doctor Who for president -Doctor, my brain hurts! -Documentation is the castor oil of programming. -Does Bill Clinton think Elvis is alive? -Does killing time damage eternity? -Does the Enterprise use DOS v2356.0? -Does the name Pavlov ring a bell? -Doesn't expecting the unexpected make the unexpected become the expected? -Dogs come when you call. Cats have answering machines. -Dogs crawl under Gates, software under Windows. -Don't Take Life Seriously, It Is Not Permanent. -Don't ask me, I have intermittent memory loss -Don't ask me, I only work here. -Don't ask me, I'm making this up as I go! -Don't be a sexist, broads hate that. -Don't be afraid to drive a nail in the wood! -Don't believe everything you hear or anything you say. -Don't blame me, I voted for Mickey Mouse. -Don't buy furs, it takes trees to make protest signs. -Don't byte off more than you can multiplex. -Don't confuse me with facts, my mind's already made up! -Don't crush that dwarf, hand me the pliers. -Don't diet, download a virus to remove the FAT. -Don't do what I SAY, do what I mean! -Don't get stuck in a closet -- wear yourself out. -Don't just do something !!! Stand there !!! -Don't let school interfere with your education. -Don't look at me in that tone of voice! -Don't look back, the lemmings are gaining on you. -Don't mess with Murphy. -Don't panic. Don't panic. Don't panic. ... ALL RIGHT, NOW PANIC -Don't play stupid with me! I'm better at it. -Don't press the keys so hard! -Don't read everything you believe. -Don't rush me. I get paid by the hour. -Don't speak now, and forever hold your peace. -Don't start with me. You know how I get. -Don't steal. The government hates competition. -Don't stop posting, a good laugh breaks up my day nicely -Don't sweat it -- it's only ones and zeros. -Don't talk unless you can improve the silence. -Don't thank me for insulting you. It was my pleasure... -Don't try to saw sawdust. -Don't use a big word where a diminutive one will suffice. -Don't use no double negatives. -Don't worry, I'm fluent in weirdo. -Down with categorical imperative! -Down with ignurance! -Downgrade your system for only 89 dollars! Install Windows! -Dragons love you. You're crunchy and good with ketchup. -Drama is life with the dull bits cut out. -Drawing on my fine command of language, I said nothing -Drilling for oil is boring. -Drink wet cement, and get completely stoned. -Drive A: format failure, formatting C: instead... -Drive C: Error, (A)bort (R)etry (I)gnore (K)ick (S)cream -Dropped from my peeling lips like lousy fruit. -Drugs have taught an entire generation of American kids the metric system. -Dumb luck beats sound planning every time. Trust me. -Dying is no excuse. Nixon in 96. -Dyslexics are persona au gratin. -Dyslexics have more fnu. -Dyslexics of the world, UNTIE! -EMS: Enhanced Money Scam -ERROR 103: Dead mouse in hard drive. -EXPANSION SLOTS: The extra holes in your belt buckle. -Eagles may soar but weasels aren't sucked into jet engines! -Easter is canceled this year. They've found the body. -Eat Healthy, Exercise, and Die Anyway ... -Eat the rich, the poor are tough and stringy -Efficiency takes time! Frugality: who can afford it? -Eggheads unite! You have nothing to lose but your yolks. -Ego Gratification through Violence -Either this man is dead or my watch has stopped. -Email me the rules, please! -Energizer Bunny Arrested! Charged with battery. -Enjoy me, I may never pass this way again. -Enough research will tend to support your theory. -Ensign Pillsbury: He's bread Jim! -Enter that again, just a little slower. -Error 15 - Unable to exit Windows. Try the door. -Eschew obfuscation! -Even in this corner of the galaxy, Captain, 2+2=4 ... Spock -Even snakes are afraid of snakes. -Even the greatest of whales is helpless in the middle of the desert -Ever notice how fast Windows runs? Neither did I... -Ever stop to think, and forget to start again? -Ever wonder why Oprah spelled backwards is Harpo? -Every man's work is a portrait of himself. -Every purchase has its price. -Every why hath a wherefore. -Everybody is ignorant, only on different subjects. -Everybody wants to go to heaven, but nobody wants to die. -Everyone has photographic memory...some don't have film! -Everyone hates me because I'm paranoid -Everyone is entitled to my opinion. -Everyone is gifted. Some open the package sooner. -Everyone's expendable...and no one has a real friend -Everything bows to success, even grammar. -Everything in our favor was against us. -Everything that is not mandatory is forbidden. -Everywhere is walking distance if you have the time. -Evil always triumphs over good, because good is STUPID! -Exceeding the legal fun limit on a regular basis -Excellent time to become a missing person. -Excuse me while I dance a little jig of despair -Excuse me while I sharpen my tongue. -Experience is a good teacher but her fees are high... -Experience: a name everyone gives to his mistakes. -Exploding piglets!!! My gosh, it's raining bacon! -Exxon Suxx. -F.A.R.T....Fathers Against Radical Teenagers -FATAL SYSTEM ERROR: Press F13 to continue... -FIGHT BACK! Fill out your tax forms with Roman numerals. -FILE COPIED. I THINK? -FLOPPY DISK: Serious curvature of the spine. -FOR SALE: 1 set of morals, never used, will sell cheap. -FORD: The Heartbreak of today's Chevrolet! -Fact is solidified opinion -Facts Just Get In The Way And Impede Progress. -Facts are stubborn things. -Fad: In one era and out the other -Familiarity breeds attempt -Familiarity breeds children. -Famous last words - Don't worry, I can handle it. -Famous last words - Icarus: Aaaahhhhhhhhh. -Famous last words - You and what army? -Faster than a speeding ticket! -Fat Wars: May the Sauce Be With You. -Fat person: Nutritional Overachiever -Fatal Error Using Mouse. Replace and Bury Operator. -Features should be discovered, not documented. -Feel lucky???? Update your software! -Felines... nothing more than felines... -Fer sell cheep: IBM spel chekker. Wurks grate. -Fife. n. Small shrill instrument that rhymes with wife. -Figures won't lie, but liars will figure. -File not found. Should I fake it? (Y/N) -Find your aim in life, before you run out of ammunition -First thing you do is shoot all the lawyers -Fish and visitors stink in three days. -Flames to /dev/null/here/is/a/quarter/now/go/buy/a/clue. -Flaming nuclear death to Smurfs -Flirt: A woman who thinks it's every man for herself. -Floggings will continue until morale improves. -Flying saucers are real, the Air Force doesn't exist. -Folks who think they know it all bug those of us who do -Follow-ups to alt.nobody.really.cares -Food is an important part of a balanced diet. -Fools rush in where Fools have been before! -Fools rush in wherever lottery tickets are sold -For Sale: Slightly used message. Enquire within. -For at the end of history lies the undiscovered country. -For discussion only. Not to be relied upon. -For every vision there is an equal and opposite revision. -For people who like peace and quiet: A phoneless cord! -For sale, Toilet-seat cover. Barely used. -For the finest in brain candy. -Forget the Joneses...I can't keep up with the SIMPSONS! -Forget the computer! Where's my abacus?? -Forget the diet center; send yourself a candygram. -Forgive your enemies...but REMEMBER THEIR NAMES! -Four minus two is one and the same. -Fraud(n): A telephone number starting with '1-900' -Free Nelson Mandela, while stocks last! -Free advice is worth what you pay for it -Free your mind ... the rest will follow! -Freedom is just chaos with better lighting. -Friction can be a drag sometimes. -Friendly fire - ISN'T ! -Friends are Friends, regardless of their baud rate! -Friends come and go, enemies accumulate. -Friends don't let friends drive naked. -Friends encourage friends to use Windows - under Linux! -Friendship is one soul in two bodies. -Frost -Funny, only sensible people agree with me. -GURU: One who knows more jargon than you. -Gambling: The sure way of getting nothing for something. -Gargle twice daily - see if your neck leaks. -Geez if you belive in honkus. -Genealogy = A DNA square-dance in the Thighlight Zone -General Failure reading John Dvorak -General stupidity error reading drive C: -Geoff, Brett and Todd...the BO-DYNASTY!!! -George Orwell was an optimist. -Get behind early so you have plenty of time to catch up. -Get the facts first - you can distort them later! -Get your filthy hands off my dessert! -Gimme back my face! You're getting it ugly. -Give a woman an inch and she'll park a car in it. -Give a woman an inch and she thinks she's a ruler. -Give your child mental blocks for Christmas. -Go Lemmings, Go!!! -Go shopping. Buy Stuff. Sweat in it. Return it the next day. -God created cats so that men could learn to understand women -God does not play dice. -God heals and the doctor takes the fee. -Going out of my mind, back in 5 minutes. -Going the speed of light is bad for your age. -Good day to let down old friends who need help. -Good girls go to heaven...but bad girls go EVERYWHERE!! -Goodness has NOTHING to do with it..... -Gotta love me! -Grab your helmet, get your bike, it's SHOWTIME! -Graduate Of The Uncle Fester & Keith Moon School of hair styling -Gravity brings me down -Gravity doesn't exist. The Earth sucks. -Great minds travel in the same sewers. -Greed is good! Greed is right! Greed works! -Grow your own dope... plant a man -Growing old is mandatory; growing up is optional!! -Grub first, then ethics. -Gun control is being able to hit your target! -Guns don't kill people... death does. -Guns don't kill people..., I kill people! -H lp! S m b d st l ll th v w ls fr m m k yb rd! -HAL 9000: Dave. Put down those Windows disks, Dave. DAVE! -Hackito ergo sum. -Hailing frequencies open, Captain. -Hand me that crowbar... I must pry out this bullet. -Happiness is Earth in your rear view mirror. -Happiness is a warm gun. -Happiness is a warm modem -Happiness is finding special characters  -Happiness is not a destination. It's the trip. -Happiness is seeing your mother-in-law's face on the back of a milk carton. -Happiness is...receiving YOUR posts!!!! -Hard work has a future payoff. Laziness pays off now. -Hard work must have killed someone! -Has it ever rained cats and dogs? -Hasta la vista, Baby! -Have Tardis, will travel. -Have an adequate day. -Have cursor, will curse. -Have it OUR way. Yours is IRRELEVANT. At BORGerKing. -Have you ever talked into an acoustic modem? -Have you seen Quasimoto? I have a hunch he's back! -Having Windows problems? Dial 1-800-3-IBM-OS2 for fast relief! -Having two bathrooms ruins the capacity to co-operate. -He does the work of 3 Men...Moe, Larry & Curly -He has Van Gogh's ear for music. -He who Laughs, Lasts. -He who always plows a straight furrow is in a rut. -He who asks timidly makes denial easy. -He who dies with the most access, wins. -He who dies with the most toys... is *still* DEAD! -He who eats too many prunes, sits on toilet many moons. -He who hesitates is constipated. -He who laughs last is S-L-O-W. -He who laughs last probably made a backup. -He who lives by the sword laughs last. -He who places head in sand, will get kicked in the end! -He who shouts the loudest has the floor. -He who sitteth on an upturned tack shall surely rise. -He's dead Jim. Grab his tricorder. I'll get his wallet. -He's dim, Jed -He's not dead, Jim, he's just metabolically challenged. -Heads I win... DITTO tails -Health food makes me sick. -Heisenberg slept here, I think. -Help endangered species - adopt a KGB operative. -Help fight continental drift. -Help stamp out mental illness, or I'll kill you! -Help stamp out, eliminate and abolish redundancy! -Help! I'm lost somewhere in the Generation Gap. -Help! I've been stuck in here for years and years... -Help! Police! That guy stole my .sig! STOP!!! THIEF!!! -Help!!! I'm falling and I can't click out!!! -Help, I'm slipping into the Twilight Zone! -Here today, gaunt tomorrow. -Hey! Hacker! Leave those lists alone! -Hey! This is a morgue, not an amusement park! -Hey! Who took the cork off my lunch??! -Hey, CServe/Unisys! Stick it where the sun don't shine! -Hey, Worf...I hooked Data up to a Modem...Wanna see? -Hi! I can't remember your name either. -Hi, I'm from Corporate. I'm here to help you. -Hi. I'll be your tagline for this evening. -High message: 9434567. Message last read: 9. -Hills weed out the weak. Darwin would argue this is good. -Hindsight is always 20:20. -Hindsight is an exact science. -Hm..what's this red button fo:=/07<NO CARRIER -Hmm...Nice tagline. <SWIPE!> SUCKER!!! AH, HAHAHAHAHAHAHAHA! -Hollow chocolate has no calories -Hollywood is like Picasso's bathroom. -Honey, PLEASE don't pick up the PH$@#*&$^(#@&$^%(*NO CARRIER -Honeymoon Salad: Lettuce alone, with no dressing. -Honeymoon: time between 'I do' and 'you'd better' -Honk if you love cheeses. -Honk if you love peace and quiet. -Honk, if you have slept with Clinton. -Hors d'oeuvres--a ham sandwich cut into forty pieces. -Housework done properly, can kill you -Houston! do you read. -How come the AT&T logo looks like the Death Star? -How come there's only one Monopolies Commission? -How come wrong numbers are never busy? -How do I set my laser printer for stun? -How do you know it's summer in Seattle? Rain's warm! -How do you make Windows faster ? Throw it harder -How do you pronounce my name? With reverence. -How do you write zero in Roman numerals? -How does Michael Jackson pick his nose? From a catalog! -How does one expect the unexpected? -How long is a short story? -How long will a floating point operation float? -How many consultants will fit onto the head of a pin? -How many of you believe in telekinesis? Raise MY hand! -How many weeks are there in a light year? -How much can I get away with and still go to heaven? -How much deeper would the ocean be without sponges? -Humpty dumpty was pushed. -Hydrate or Die. -Hypochondria is the only disease I haven't got. -I *LOVE* it when a plan comes together! -I BBS because no one can read my handwriting. -I Cayman went. -I Have To Stop Now, My Fingers Are Getting Hoarse! -I M a tru beleever in hour edukashun sistum. -I Still miss my ex-wife.....BUT, My aim is improving! -I Think....therefore I'm OVER QUALIFIED!!!!!!!!! -I love it when a plan comes together! -I admit it's offbeat, but lets not get hysterical. -I always lie. In fact, I'm lying to you right now! -I always like to try the one I've never tried before. -I am Clinton of Borg. Your income will be assimilated. -I am Homer of Borg! Prepare to be...OOooooo! Donuts!!! -I am Lancelot of Borg. Resistance is feudal. -I am both of us & so are you. -I am built for comfort, not speed! -I am free of all prejudice. I hate everyone equally. -I am functioning within established parameters. -I am in total control, but don't tell my wife. -I am not an animal! I am ... well, not an animal. -I am serious. And don't call me Shirley. -I am sweet and lovable at all times. -I am the girl-next-door's imaginary boyfriend. -I am what I am and that's all that I am. -I am. Therefore, I think. I think. -I apologize to the deaf for the loss of subtitles. -I bet you I could stop gambling. -I bought a cordless extension cord. -I came, I saw, I did a little shopping. -I came, I saw, I took LOTS of PICTURES! -I came... I saw... I stole your tagline. -I can do without essentials but I must have my luxuries -I can quit anytime I want; I just don't want to! -I can resist anything but temptation. -I can tell you are lying. Your lips are moving. -I can walk on water, but I stagger on alcohol. -I can't be overdrawn, I still have checks left! -I can't believe my computer's on fire. -I can't hear you. There's a banana republic in my ear. -I cna ytpe 300 wrods pre mniuet!!! -I could be arguing in my spare time. -I could have stuck with DOS, but NO. -I couldn't care less about apathy. -I didn't cheat, I just changed the Rules! -I didn't know it was impossible when I did it. -I distinctly remember forgetting that. -I do not fear computers. I fear the lack of them. -I do this kind of stuff to him all through the picture. -I don't care if I'm apathetic. -I don't care who you are, Fatso. Get the reindeer off my roof! -I don't care who you are, what you are driving, or where you would rather be. -I don't eat snails... I prefer FAST food! -I don't hate Windows - it runs great under Linux! -I don't have a solution but I admire the problem. -I don't lie, cheat or steal unnecessarily. -I don't need a disclaimer. I OWN the company. -I don't think, therefore I am not. -I don't want the world, I just want your half. -I drink to make other people interesting. -I eat Swiss cheese from the inside out. -I feel like a fugitive from the law of averages. -I feel so inar-inar-inar tic-u-late -I feel the need......the need for speed! -I finally washed the mud off of mud. -I find myself beside a stream of empty thought -I float like an anchor and sting like a moth. -I get mail........ I exist. -I give advice worth the price....free! -I got arrested in LA and boy am I beat! -I guess a cynic smells different. -I had a life once... now I have a computer and a modem. -I had amnesia once or twice. -I had my coat hangers spayed. -I hate quotations. Tell me what you know. -I hate to repeat gossip, so I'll only say this once. -I have a 9600bps modem and 1.5bps fingers -I have a rock garden. 3 of them died last week. -I have a speech impediment... my foot. -I have already not made that point -I have seen the evidence. I want DIFFERENT evidence! -I have seen the truth and it makes no sense. -I have the mars observer and I'm not returning it until I get an 'A' in astronomy -I haven't lost my mind -- it's backed up on tape somewhere. -I haven't lost my mind, I know exactly where I left it. -I hear what you're saying but I just don't care. -I is a college student. -I is knot dain bramaged! -I just bought a cured ham. Wonder what it had? -I keep my .BAT files in D:\BELFRY -I know Karate, Kung Fu, and 47 other dangerous words -I know everything about everything, except that. -I know it all. I just can't remember it all at once. -I like candy, especially the gooey kind with nougat! -I like kids, but I don't think I could eat a whole one. -I like to leave messages *before* the beep. -I like to reminisce with people I don't know. -I like to think of myself as a divide overflow. -I like your approach, now let's see your departure. -I lost a button hole today. -I lost my knickers at Niagara. -I made it foolproof. They are making better fools! -I may be fat but you're ugly, and I can lose weight. -I may be getting older, but I refuse to grow up -I may not always be perfect, but I'm always me. -I may not be perfect, but parts of me are excellent. -I mustanottagottalotta sleep last night. -I need someone really bad. Are you really bad? -I never deny, I never contradict. I sometimes forget. -I never met a chocolate I didn't like! -I only counted 100 dalmatians...!!! -I owe, I owe, it's off to work I go. -I parked my hard disk and now I can't find it! -I planted some bird seed. A bird came up. -I post.......... I am -I promise results, not promises. -I refuse a battle of wits with an unarmed person! -I remember when Saturns were rockets, not cars. -I saw, I came, I cleaned it up. -I smashed a Window and saw... Linux! -I spilled spot remover on my dog, and now he's gone. -I think I strained a muscle I didn't know I had! -I think, therefore I am. I think. -I think. Therefore I am DANGEROUS. -I thought I was wrong but I was mistaken. -I tried being reasonable once. I didn't like it. -I tried switching to gum but I couldn't keep it lit. -I tried to daydream, but my mind kept wandering. -I tried to drown my problems but they can swim! -I try to make everyone's day a little more surreal. -I used to be disgusted, but now I'm just amused. -I used to be indecisive, now I'm not so sure. -I used to be schizophrenic, but we're all right now. -I used to have a handle on life, then it broke. -I used to spell badlie, but now I got worser. -I used to watch TV, then I bought a modem. -I wake near the end of the day. -I want .50 cal machine guns as a factory option. -I warn you not to underestimate my powers. -I was arrested for selling illegal sized paper. -I was arrested for walking in someone else's sleep. -I was going to procrastinate, but I put it off.... -I went on a 30-day diet - and lost 30 days! -I will defend to your death my right to my opinion. -I wish life had a scroll-back buffer. -I wouldn't touch the Metric System with a 3.048m pole! -I wrote a few children's books, but not on purpose. -I xeroxed my watch. Now I have time to spare. -I'd give my left arm to be ambidextrous -I'd like to live like a poor person with lots of money. -I'd like to, but last time I went I never came back.. -I'd love to, but I have to fulfill my potential. -I'd love to, but I have to rotate my crops. -I'd love to, but I have to stay home and see if I snore -I'd love to, but I prefer to remain an enigma. -I'd love to, but I think you want the OTHER Phillip. -I'd love to, but I'm trying to be less popular. -I'd love to, but I've dedicated my life to linguini. -I'd love to, but my crayons all melted together. -I'd love to, but my favorite commercial is on TV. -I'd love to, but my patent is pending. -I'd love to, but none of my socks match. -I'd love to, but there's a disturbance in the Force. -I'd love to, but you know how we psychos are. -I'd rather be bicycling! -I'll eat anything that's BRIGHT BLUE!! -I'll get you my pretty, and your little dog too! -I'll get you yet, you kwazy wabbit! -I'll jump off that bridge when I come to it. -I'll tell you what's the matter! This parrot is dead! -I'm Not Schizophrenic, And Neither Am I. -I'm Serfectly Pober. -I'm a Bum...a BEACH Bum! -I'm a cowboy ... on a steel horse I ride! -I'm a lumberjack, and I'm okay! -I'm a nobody, nobody is perfect, therefore I'm perfect. -I'm an Debian developer...I don't NEED a life! -I'm an absolute, off-the-wall fanatical moderate. -I'm an incorrigible punster, so don't corrige me! -I'm an influential person, gravitationally speaking. -I'm as bored as a pacifist's pistol. -I'm at the corner of Walk and Don't Walk. -I'm dangerous when I know what I'm doing. -I'm easy to please as long as I get my way. -I'm fallin' down a spiral, destination unknown! -I'm fascinated by the way memory diffuses fact. -I'm in shape ... Rounds a shape isn't it? -I'm leaving my body to science fiction. -I'm moving to Mars next week, so if you have any boxes. -I'm new and what's all this then? -I'm no stranger, just a friend you haven't met... -I'm not a complete idiot - several parts are missing. -I'm not as dumb as you look. -I'm not broke, I'm just badly bent. -I'm not dead. I'm electroencephelographically challenged. -I'm not even going to ignore that. -I'm not fat just horizontally disproportionate. -I'm not loafing. I work so fast I'm always finished -I'm not lost, I'm 'locationally challenged.' -I'm not nearly as think as you confused I am. -I'm not opinionated, I'm just always right! -I'm not paranoid! Which of my enemies told you this? -I'm not real smart, but I can lift heavy things. -I'm not rude, I'm 'attitudinally challenged'. -I'm not schizophrenic. It's this guy beside me! -I'm not tense, just terribly alert. -I'm on the crest of a slump. -I'm out of sick days, so I'm calling in dead! -I'm pink, therefore I'm Spam. -I'm schizophrenic, What are you? -I'm so broke, I can't even pay attention. -I'm spending a year dead for tax purposes. -I'm sure it's clearly explained in the Zmodem DOC's -I'm sure it's in the manual somewhere... -I'm the person your mother warned you about. -I'm too smart to let my intelligence go to my head. -I'm turning you in to the SPCA! -I've been seduced by the chocolate side of the force. -I've got Parkinson's disease. And he's got mine. -I've got a mind like a.. a.. what's that thing called? -I've got to sit down and work out where I stand. -I've had fun before. This isn't it. -I've run out of sick leave so I'm calling in dead. -I've seen the future. I can't afford it. -IBM: I've Been Misled -IBM: It may be slow, but at least it's expensive. -IBM: you can buy better, but you can't pay more -IF numcooks > .maxcooks THEN;SET V broth = 'spoiled';END -INTERLACE: To tie two boots together. -Ideas are not responsible for their followers! -If At First You Don't Succeed Ignore The Docs... -If Clinton's the answer, it must have been a really stupid question. -If I can't fix it, it's probably dead. -If I can't win, I don't wanna play! -If I had anything witty to say, I wouldn't put it here. -If I had been using Windoze, I'd still be writing this. -If I save the whales, where do I keep them? -If I save time, when do I get it back ? -If I want your stupid opinion, I'll beat it out of you. -If I were here more often, I wouldn't be gone so much. -If I were two faced, would I wear this one? -If I were you, who'd be me? -If Murphy's Law can go wrong, it will. -If The Shoe Fits - The Sock Fits ! -If a fly has no wings would you call him a walk? -If a tree falls on a florist, would he make a sound? -If all goes well, you've overlooked something! -If all you have is a hammer, everything looks like a nail -If at first we don't succeed, we run the risk of failure. -If at first you don't succeed, call it v1.0! -If at first you don't succeed, hide your astonishment. -If at first you don't succeed, put it out for beta test. -If at first you don't succeed, redefine success. -If at first you don't succeed, skydiving isn't for you. -If at first you don't succeed, work for Microsoft. -If at first you don't succeed, you must be using Windows. -If brains were dynamite you couldn't blow your nose! -If cows could fly, everyone would carry an umbrella. -If evolution is outlawed, only outlaws will evolve. -If idiots could fly, this would be an airport. -If in doubt, make it sound convincing. -If it glows don't touch it! -If it has feelings, its not cooked enough! -If it isn't broken, don't fix it. -If it jams, force it. If it breaks, it needed replacing -If it walks out of your refrigerator, LET IT GO !! -If it works, tear it apart and find out why! -If it's not broke, let me take a crack at it. -If it's not going to plan, maybe there never was a plan. -If it's not on fire, it's a software problem. -If it's not worth doing well, it's not worth doing. -If it's stupid and works, then it ain't stupid -If it's too loud, you're too old. -If life gives you lemons, make lemonade. -If little else, the brain is an educational toy. -If marriage is outlawed, only outlaws will have inlaws. -If money could talk, it would say goodbye. -If nobody measures up, check your yardstick. -If rabbits feet are so lucky, what happened to the rabbit? -If speed scares you, try Windows... -If the shoe fits, put it in your mouth. -If there are epigrams, there must be meta-epigrams. -If there's one thing I can't stand, it's intolerance. -If this were an actual tagline, it would be funny. -If truth is stranger than fiction, you must be truth! -If voting changed anything, they'd make it illegal. -If winning isn't important then why keep score? -If you associate with the wise, you will become wise. -If you believe in telekinesis, raise my hand. -If you can't run with the big dogs, stay on the porch. -If you cannot convince them, confuse them. -If you choke a smurf, what color does it turn? -If you didn't get caught, did you really do it? -If you don't care where you are, then you ain't lost. -If you don't like my opinion of you - improve yourself! -If you don't like the news, go out and make some of your own. -If you have nothing to do, don't do it here. -If you have to ask what jazz is, you'll never know. -If you hear an onion ring please answer it. -If you mess with something long enough it'll break. -If you must drink and drive, drive a Yugo! -If you saw a heat wave, would you wave back? -If you say nothing, no one will repeat it. -If you see an onion ring, ANSWER IT! -If you think education is expensive, try ignorance. -If you try to fail, and succeed, which have you done? -If you want your name spelt wrong, die. -If you wish work poorly done, pay in advance. -If you're not confused, you're not paying attention. -If you're not the solution, you're the precipitate. -If your attack is going well, then it's an ambush.. -If your ship doesn't come in, swim out to it! -Ifyoucanreadthis,youspendtoomuchtimefiguringouttaglines! -Ignorance is temporary; stupid is forever. -Illiterate? Write for free help. -Imagery is All In The Mind. -Imagination is the only weapon in the war against reality -Impropriety is the soul of wit. -In God we trust, all others pay cash. -In a fight between you and the world, back the world. -In case of emergency, break glass. Scream. Bleed to death -In case of fire, yell 'FIRE!' -In politics stupidity is not a handicap. -In the land of the witless, the halfwit is king. -In war there is no substitute for victory. -Include this in your CONFIG.SYS File: BUGS=OFF -Incompetence plus incompetence equals incompetence. -Individualists of the world, UNITE! -Inertia makes the world go round. -Inferiority complex: conviction by a jury of your fears. -Innovate or Die. -Insanity is hereditary. You get it from your kids. -Insanity is just a state of mind. -Insert New Disk for Drive C: Press ENTER when ready. -Insert inevitable trivial witticism of your choice. -Interchangeable parts won't. -Internal combustion engines are the dinosaurs' revenge -International Brotherhood of Tagline Thieves. -Interstellar Matter is a Gas -Invisible Systems, Inc. If you don't see it, we made it. -Iron Law of Distribution: Them that has, gets. -Is 'tired old cliche' one? -Is it OK to yell 'MOVIE' in a crowded firehouse? -Is it in my head...or in my heart? -Is it ok to use my AM radio after NOON? -Is it possible to feel gruntled? -Is that a flying saucer or a pie in the sky? -Is there life before coffee? -Is this a machine? I don't talk to machines! [Click] -Is this the right room for an argument? -It all looks the same if you're not the lead dog. -It can't be full...I STILL HAVE SUBDIRECTORIES! -It compiled, first screen came up?? Ship it! --Bill Gates -It did what? Well, it's not supposed to do that. -It doesn't work, but it looks pretty. -It has many other uses as well. Allow me. - Worf -It is always better to sacrifice your opponent's men -It is bad luck to be superstitious. -It is better to be brief than boring. -It is better to wear out than to rust out. -It is broke. It will not work. It does not go. -It is fatal to live too long. -It is incumbent on us to avoid archaisms. -It is morally wrong to allow suckers to keep their money. -It is much easier to be critical than to be correct -It is not enough to succeed. Others must fail. -It is, after all, only a moment in the infinity of time. -It really bothers me when people cut me o... -It said 'Insert disk #3', but only two will fit! -It works better if you plug it in. -It's 10:00 PM...do YOU know where YOUR tagline is? -It's Ensign Flintstone - he's Fred, Jim. -It's a Tough Job! ..... So I'd Rather YOU do it. -It's a fine line between fishing & standing still -It's a fine night to have an evening. -It's a good thing we don't get all the government we pay for. -It's a tough job! ..... So I'd Rather YOU do it. -It's an ill wind that gathers no moss. -It's as bad as you think and they are out to get you. -It's bad luck to be superstitious. -It's been a business doing pleasure with you. -It's been lovely, but I have to scream now. -It's best to leave quickly when you make noises like that... -It's better to burn out than to fade away. -It's clever, but is it art? -It's deja vu all over again. -It's easier to get older than it is to get wiser. -It's easier to obtain forgiveness than permission. -It's easy to apply yourself, just use crazy glue! -It's easy to be brave from a safe distance. -It's hard to RTFM when you can't find the FM.. -It's hard to be serious when you're naked. -It's life Jim, but not as we know it. -It's like Deja Vu all over again... -It's lonely at the top, but you eat better. -It's more than a reader. It's a message base manager! -It's never too late to have a happy childhood -It's not easy having an overbearing parent! - Troi -It's not hard to meet expenses, they're everywhere! -It's not in the manual! -It's not just a hobby, it's an obsession! -It's not pretty being easy. -It's not the bullet that kills you, it's the hole. -It's not the money I want, it's the stuff. -It's not the principle of the thing, it's the money -It's okay to be ugly...but aren't you overdoing it? -It's only a hobby ... only a hobby ... only a hobby ... only -It's only ones and zeros. -It's raining, it's pouring, the old man is...dead, Jim. -It's smart to pick your friends, but not your nose. -It's starting to rain, .SQZ the animals into the .ARC ! -It's true, forgiveness IS easier to get than permission -Its a JOKE, like the funny kind but different. -Itsdifficulttobeverycreativewithonlyfiftysevencharacters! -JFK: I need this motorcade like a hole in my head! -James Bond rules. 00K. -Jealousy is all the fun you think they have. -Jet Engine Theory -Suck, Squeeze, Bang, Blow! -Join the Group Mind - become a Borg -Joseph Stalin's grave was a Communist Plot. -Jumbo shrimp = oxymoron. -Junk: stuff we throw away. Stuff: junk we keep. -Just because you're STUPID ain't no excuse. -Just because I'm paranoid doesn't mean they aren't out to get me! -Just do it. -Just don't tell the asylum you saw me here -Just how much leg have I got -Just my 78,000 lira worth. -Just what part of 'NO' didn't you understand...? -Just when you think you've won the rat race along come faster rats. -Justice is incidental to law and order. -Justice: A decision in your favor. -Kamikaze Pilot Wanted: Experienced only need apply. -Keep America beautiful.. properly dispose of your lawyer. -Keep a clear head and always carry a lightbulb. -Keep emotionally active. Cater to your favorite neurosis. -Keyboard Not Found - Press [F1] to Continue -Kicked wide of the goal with such precision. -Kids-They're not sleeping, they're recharging! -Kill them all! .... Let God sort them out. -Killer Rabbit's Motto: 'Lettuce Prey.' -Kilroy occupied these coordinates. -Kleptomania: take something for it -Know what I hate? I hate rhetorical questions! -Knowing Murphy's Law won't help either. -LISP: To call a spade a thpade. -LISTEN HERE! I HAVE FIRST AMENDENT RIGH(@#$!9*&^ NO CARRIER -LOTUS - Let Only The Users Suffer -Laddie, ya think ya might like ta ... rephrase that? -Land of the Single Entendre... -Last week I forgot how to ride a bicycle. -Laugh and the world thinks you're an idiot. -Laughter: The shortest distance between two people. -Lead me not into temptation, I can find it myself. -Lesser artists borrow. Great artists steal. -Let he who takes the plunge remember to return it! -Let's organize this thing and take all the fun out of it. -Let's split up, we can do more damage that way. -Liberal - a power worshiper without power. -Libraries: There are no answers, only cross references. -Life - brief interlude between nothingness and eternity. -Life can be great if you live it to the fullest! -Life is a sandwich, and it's always lunchtime -Life is a series of very rude awakenings. -Life is like a Car-wash and I'm on a bicycle. -Life is only as long as you live it. -Life is serious, but ART is fun! -Life is tough. It's tougher when you're stupid. -Life is uncertain...eat dessert first! -Life sucks, but Death swallows! -Life would be easier if I had the source code. -Life's too short to dance with ugly men. -Life's too short to dance with ugly women. -Life, loathe it or ignore it, you can't like it. -Likelihoods, however, are 90% against you. -Likes and dislikes are among my favorites -Linux, the choice of a GNU generation. -Liposuction will destroy your FAT -Lisp programmers have to stop and collect garbage. -Live before you die. -Living poor is best left to those with no money. -Locked coathanger in car. Good thing I had a key. -Looks like I picked the wrong week to stop sniffing glue. -Love is blind, marriage is the eye-opener. -Luxuriantly hand-crafted from only the finest ASCII. -M.A.D.D.: Midgets Against Desk Drawers. -MOPAR = Move Over Plymouth Approaching Rapidly! -MS Windows -- From the people who brought you EDLIN! -MS-DOS: celebrating ten years of obsolescence -Macho does not prove Mucho. -Madness takes its toll; please have exact change. -Make Headlines..use a corduroy pillow.... -Make it as simple as possible, but no simpler. -Make it do ... Or do without. -Make like a Tom and Cruise. -Make like a baby and head out. -Make like a banana and split. -Make like a drum and beat it! -Make like a tree and leave. -Make somebody happy. Mind your own business. -Make up a language and ask people for directions. -Man has his will. Woman has her won't! -Man invented language to satisfy his need to complain. -Man who get hit by car, get that run down feeling -Man who jumps through screen door likely to strain himself -Man who put head on railroad track get splitting headache -Man who run behind car get exhausted. -Man who speaks with forked tongue should not kiss balloon -Marching to a different kettle of fish. -Mary had a little RAM -- only about a MEG or so. -Math is the language God used to write the universe. -May I please be excused? My Brain is full. -May the Porsche be with you. -May you live in interesting times. -May your life be filled with experiences. -Me know gammar. Me cood use it gud. -Mediocrity requires aloofness to preserve it's dignity -Meditation is not what you Think. -Meet the new Boss--same as the old Boss... -Megabyte: A nine course dinner. -Member: International Brotherhood of Tagline Thieves! -Memory is a thing we forget with. -Mental Floss prevents Moral Decay. -Mercifully free of the ravages of intelligence -Microfiche: Sardines. -Microsoft Windows... a virus with mouse support. -Microsoft gives you Windows... Linux gives you the whole house. -Migratory lifeform with a tropism for parties -Minds are like parachutes, they only work when open. -Misfortune: The kind of fortune that never misses. -Misspelled? Impossible. My modem is error correcting! -Mistakes are often the stepping stones to utter failure. -Modem: What landscapers do to dem lawns. -Money is the root of all wealth. -Monogamy leaves a lot to be desired. -Monopoly? No, we just don't want competition. -Most of us have been at work for several hours now. -Mother is the invention of necessity. -Multitasking = 3 PCs and a chair with wheels! -Multitasking causes schizophrenia.. -Murphy is out there... waiting... -Murphy was an optimist. -Murphy's law needs to be repealed. -Must Go - My Rotweiler needs its teeth sharpened. -My *taglines* are original. *I* am a copy. -My RAM's not what it used to be, so don't quote me. -My attention isn't hard to get. It IS hard to keep... -My best friend is a social worker. -My computer has a terminal illness -My computer's sick, I think my modem's a carrier -My couch potato routine honed to perfection -My fallacies are more logical than your fallacies. -My foolish parents taught me to read and write. -My hat covers my head... Just like hair used to! -My haystack had no needle! -My head is sore, and there's a hole in the brick wall! -My inferiority complexes aren't as good as yours. -My karma ran over your dogma. -My life may be strange, but at least it's not boring -My message above. Your response here ____________. -My other computer is a Cray Y/MP-4! -My other computer is a HAL 9000. -My other computer is an abacus. -My other vehicle is a Galaxy Class Starship ... -My reality check just bounced. -My tagline can beat up your tagline! -My weight is perfect for my height... which varies. -NAVY: Never Again Volunteer Yourself -NETWORK: What fishermen do when not fishing. -NEWS! Drunk gets nine months in violin case -NEWS! Enraged cow injures farmer with ax -NEWS! Iraqi head seeks arms -NEWS! Police begin campaign to run down jaywalkers -NEWS! Stolen painting found by tree -NEWS! Survivor of siamese twins joins parents -NO! Taco Bell is NOT the Mexican Phone Company! -NUMBER CRUNCHING: Jumping on a Computer. -Naaah, real men don't read docs. -Nanosecond: Mork's stunt man. -Neil Armstrong tripped. -Neither rain, nor snow, nor l?ne n*oi*se -Neurotic: Self-taut person. -Never argue with a woman when she's tired, or rested. -Never assume. It makes an 'ass' out of 'u' and 'me'. -Never count your chickens before they rip your lips off. -Never draw fire, it irritates everyone around you -Never eat anything bigger than your head. -Never eat more than you can lift. -Never enter a battle of wits unarmed. -Never go with the odds -Never hit a man with glasses. Use your fist! -Never judge a man by his taglines. -Never let your feet run faster than your shoes. -Never mind the facts - I know what I know. -Never park your hard disk in a tow-away zone. -Never say, 'Oops!'; always say, 'Ah, interesting!' -Never test for an error you don't know how to handle. -Never trust a man who can count to 1,023 on his fingers -Never trust a skinny cook. -Never underestimate the power of human stupidity. -Never use a preposition to end a sentence with. -New Highway gets Railroaded. -Newsbytes - Microsoft announce EDLIN for Windows. -Nihilism should commence with oneself. -Ninety per cent of everything is crap. -Nitpicking: Not just a hobby, it's a way of life! -Nitrate: Lower than the day rate. -No .sig is a good .sig -No free lunch in an ecosystem. -No one EXPECTS the Spanish Inquisition!!! -No one ever said 'if I'd only spent more time in the office' -No radio. Already stolen. -No sense being pessimistic. It wouldn't work anyway. -No wanna work. Wanna bang on keyboard. -No, I'm from Iowa. I only work in Outer Space. -Nobody roots for Goliath. -Nobody shoots at Santa Claus. -Nodding the head does not row the boat. -None of you exist, my Sysop types all this in. -Nostalgia isn't what it used to be. -Not a computer nerd; merely a techno-weenie. -Not a real tagline, but an incredible soy substitute. -Not many people realize just how well known I am. -Not now, John, we gotta get on with the game show... -Not quite human any longer. -Nothing is 100% certain, bug free or IBM compatible. -Nothing is as inevitable as a mistake whose time has come -Nothing is ever so bad that it can't get worse. -Nothing is foolproof because fools are so ingenious -Nothing is impossible for anyone impervious to reason -Nothing recedes like success. -Nothing succeeds like excess. -Now entering Iowa. Please set your clocks back 20 years. -Now go away or I shall taunt you a second time. -Now is not a good time to annoy me -Now is the time for all good men to come to. -Now that I've given up hope I feel much better... -Nudge, nudge, wink, wink, know what I mean? -O Oysters come and walk with us, the Walrus did beseech. -OK Scotty, detonate and energize NOW! No, wait, I mean....... -OK, I'm weird! But I'm saving up to become eccentric. -OPERATOR! Trace this call and tell me where I am. -OUT TO LUNCH - If not back at five, OUT TO DINNER! -Obe Wan Kenobi at the dinner table: 'Use the FORKS, Luke!' -Objection, your Honor! My client is an idiot! -Objectivity is in the eye of the beholder -Objects in taglines are closer than they appear. -Of all the people I've met you're certainly one of them -Of all the things I've lost, I miss my mind the most. -Of course I'm running Windows[kVxB NO CARRIER -Oh goody! Another Muranium Explosive Space Modulator! -Oh no you don't! You're not stealing this one! -Oh no, not another learning experience! -Oh, Bullwinkle, that trick NEVER works! -Ok, I pulled the pin. Now what? Where are you going? -Okay - right after this one we're BACK to the TOPIC -Old MacDonald had a computer with an EIE I/O -Old age is better than the alternative. -On a clear disk you can seek forever. -On a scale of 1 to 10, 4 is about 7. -On an electrician's truck: Let Us Remove Your Shorts -One atom bomb can really ruin your day. -One good turn gets most of the blanket. -One is never as happy or unhappy as one imagines. -One man's Windows are another man's walls... -One man's upload is another man's download -One night I came home very late. It was the next night -One tactical thermonuclear weapon can ruin your whole day. -One way to better your lot is to do a lot better... -One way to stop a run away horse is to bet on him. -Only 19,999 lines of C++ to my next ski trip... -Only cosmetologists give make-up exams. -Only the winners decide what were war crimes. -Open Mouth. Insert Foot. Chew Carefully. -Optimization hinders evolution. -Originality is the art of concealing your sources. -Our houseplants have a good sense of humous. -Our necessities are few but our wants are endless... -Out here in the fields...I fight for my meals...! -Out of Memory!? But I fed you 6 Megs this morning! -Out of the mouths of babes does often come cereal. -Outlaw junk mail, and save the trees! -Overload--core meltdown sequence initiated. -Oxymoron - Definite possibility -Oxymoron - Military Intelligence -Oxymoron: Bosnian Cease-Fire -Oxymoron: Soviet Union. -PC! Politically Correct (or) Pure Crap! -PCBackup: 1 of 1362 disks. -PI seconds is a nanocentury. - Tom Duff, Bell Labs -PKZip - it's not just for downloads anymore -Pain is inevitable, suffering is optional. -Palindrome isn't one. -Pandemonium doesn't reign here... It pours! -Paranoia is heightened awareness. -Paranoia is simply an optimistic outlook on life. -Pardon my driving, I'm trying to reload. -Pascal: What's it Wirth? -Passwords are implemented as a result of insecurity. -Patience is a virtue that carries a lot of WAIT! -Pay your electric bill in pennies. -Peace through superior firepower. -People are always available for work in the past tense. -People say I'm apathetic, but I don't care. -People who live in glass houses shouldn't! -People who live in stone houses shouldn't throw glasses. -Perot/Bush/Quayle: The Millionaire, Skipper & Gilligan. -Pet Store: 'Buy one, get one flea.' -Petroleum and coffee had no value a few centuries ago. -Pi R squared. Nooo! Pie R round, cornbread R square! -Pizza IS the four food groups! -Plagiarism is the sincerest form of flattery. -Plagiarism prohibited, derive carefully. -Plankton lobbyist: 'NUKE THE WHALES!' -Plasma is another matter. -Please Tell Me if you Don't Get This Message -Please call the windows police. I've caught another gpf. -Please don't drink and post. -Please don't take my sunshine away. -Please recycle this tagline. Once is not enough. -Pobody's Nerfect! -Poets go from bad to verse -Point not found. A)bort, R)eread, I)gnore. -Politeness, n: The most acceptable hypocrisy. -Political panjandrums prologize pedantic paronomasia. -Political power grows out of the barrel of a gun. -Politics is the entertainment branch of industry. -Positive: Mistaken at the top of one's voice. -Pound forehead on keyboard to continue. -Power corrupts, but we need electricity. -Power corrupts. Absolute power is kind of neat. -Predestination was doomed from the start. -Predicting the future of technology is fraud with peril! -Prejudice is the reason of fools. - Voltaire. -Preserve wildlife... pickle a rat. -Press <CTRL>-<ALT>-<DEL> to continue... -Press any key to continue or any other key to quit -Press any key...NO, NO, NO, NOT THAT ONE!!!!!! -Procrastination means never having to say you're sorry. -Procrastination: The art of keeping up with yesterday. -Program too small to fit into memory. -Programming is an art form that fights back. -Progress is made on alternate Fridays. -Prosecutors will be violated -Psychiatrists stay on your mind. -Psychoceramics: The study of crackpots. -Push the limit, and the limit will move away! -Put on your seatbelt. I wanna try something. -Put people on hold when possible. -Quantum mechanics do it in leaps. -Quasimodo is a dead ringer. -Question Authority, ask me anything -RAID Antivirus - Kills Virus's DEAD!!! -Racial prejudice is a pigment of the imagination. -Radioactive halibut will make fission chips. -Random order = oxymoron -Rap music = oxymoron -Read the dictionary backwards and look for secret messages. -Real Programmers aren't afraid to use GOTO's. -Real Trekkers work out at the He's Dead Gym. -Real men don't set for stun. -Real men write self-modifying code. -Reality is a crutch for people who can't handle buttons -Reality is an obstacle to hallucination. -Reality is for people who can't handle Star Trek. -Reality is nothing but a collective hunch. -Really ?? What a coincidence, I'm shallow too!! -Recursive, adj.; see Recursive -Red ship crashes into blue ship - sailors marooned. -Reduce Carbon Dioxide emmissions - STOP Breathing -Redundancy: A Politician with an airbag in his car. -Refuse Novocain...Transcend Dental Medication! -Remember that you are unique. Just like everyone else. -Remember, If you're not in bed by 10:30..... go home! -Remember, Subaru spelled backwards is U-R-A-BUS. -Reputation: what others are not thinking about you. -Resistance Is Useless! (If < 1 ohm) -Return((usBirdInHand = 2 * InTheBush())); -Reverse the polarity of the neutron flow. -Revolution is the opiate of the intellectuals. -Road Kill Cafe: You kill 'em, we grill 'em. -Roses are red, Violet's are blue, And mine are white. -Rotisserie: a ferris wheel for chickens -Round up the usual suspects! -Rubber bands have snappy endings! -Russian Express Card motto: Don't leave home! -S met ing's hap ening t my k ybo rd . . -SCUD : Sure Could Use Directions -STICK: A boomerang that doesn't work. -STUPIDITY is NOT a HANDICAP! Park elsewhere! -SYNTAX? Why not--they tax everything else! -SYSTEM ERROR: press F13 to continue... -Santa's elves are just a bunch of subordinate Clauses. -Sarcasm: barbed ire. -Save California; when you leave take someone with you. -Save energy: be apathetic. -Save the whales! Trade them for valuable prizes! -Save the whales. Collect the whole set. -Save your money for a rainy day, or a new computer! -Say yer prayers, y' flea-bitten' varmint. -Schizophrenia beats being alone. -Science asks why. I ask why not. -Science: preconception meeting verification. -Scientists discover life causes cancer. -Scotty! Hurry! Beam me uragg^*z~% NO CARRIER -Scrute the inscrutable, eff the ineffable. -See how you can be? -Seeing is deceiving. It's eating that's believing. -Send lawyers, guns, & money... -Send more tourists..... the last ones were delicious! -Sentient plasmoids are a gas. -Serving the scum of Paris for over 300 years -Set mode=Extremely verbose -Shareware author dies: .GIF at eleven! -Shareware: forget the manual...phone the author at home! -ShelfDoze is a registered Trademark of M$. -Shell to DOS... come in DOS... Do you copy? -Shh! Be vewy quiet, I'm hunting wuntime errors! -Shin - a device for finding furniture in the dark.. -Shoot your program and put it out of its memory! -Shoplifters with the runs take Clepto Bismol -Short people are vertically challenged. -Should I or shouldn't I?... Too late, I did! -Should I weed the lawn or say it's a garden? -Show me a sane man. I'll cure him for you. -Sign here please:_______________________Thanks -Sign on Closed Nuclear Power Plant... 'Gone Fission' -Sign on a clothing store - Come inside and have a fit. -Signito ergo sum - I sign therefore I am. -Simon says: don't be so suggestible. -Sit down, you're rocking the boat! -Six of one, 110 (base 2) of another. -Skating away on the thin ice of a new day. -Slower Traffic Keep Right - Is that so difficult? -Slug Sautee: a hors of a different d'oeuvre. -Small changes pick up the reins from nowhere. -Smash forehead on keyboard to continue... -Smile. It's the second best thing you can do with your lips. -Smile... people will wonder what you've been up to. -Smiley faces were meant to be annoying. -Smokey the Bear says, 'Strip mining prevents forest fires!' -Smoking cures weight problems...eventually. -Smoking is a leading cause of statistics. -Smurf exterminator. -So many bytes, so few cps. -So many lawyers, so few bullets. -So many pedestrians, so little time. -So many toys, so little time... -So much time, and so little to do. -Socialism is the equal distribution of poverty. -Software Independent: Won't work with ANY software. -Software means never having to say you're finished -Some Do, Some Don't, Some Will and Some Won't. -Some People.... -Some days you're a bug, other days a windshield. -Some days, nothing goes left. -Some little dipstick stole all my good taglines... -Some minds should be cultivated, others plowed under... -Some people are so nice to be nasty to. -Some people are, through no fault of their own, sane. -Some things have got to be believed to be seen. -Someone is unenthusiastic about your work. -Something is rotten in the state of confusion. -Sometimes a cigar is just a cigar. -Sorry about your Rectal-Cranial Inversion. -Sorry, I don't date outside my species. -Sorry... my mind has a few bad sectors. -Southern DOS: Y'all reckon? (yep/Nope) -Space is an illusion, disk space doubly so. -Space is big. Really big. -Spaceman Spiff, Interplanetary Explorer! -Speaking only for myself, one of my many tricks. -Spell chequers dew knot work write. -Spice is the variety of life. -Stamp out philately! -Standing there making a sitting target of himself. -Stay Alert. Stay Awake. Stay Alive. -Steal my cash, car and TV - but leave the computer! -Sterility is hereditary. -Stop tagline theft! Copyright your tagline © -Strike any user when ready. -Stupidity got us into this mess, why can't it get us out? -Subvert the dominant paradigm! -Suicide is the most sincere form of self criticism. -Sumo Wrestling: survival of the fattest. -Supercalifragilisticexpialidocius -Supernovae are a Blast -Support bacteria - it's the only culture some people have! -Support the helpless victims of computers. -Surprise your boss. Get to work on time. -Swish, two, three, four! Swish, two, three, four! -Sylvester Stallone: father of the RISC concept. -THE GOLDEN RULE: He who has the gold makes the rules -TV is chewing gum for the eyes. -Tact: knowing how far to go too far. -Tact: making a point without making an enemy. -Tagline Lotto: 2222222222<- Scratch here for prize. -Tagline theft is a compliment. -Taglines \'tag-linz \ The bumperstickers of the internet -Take a bite out of crime .. Abolish the IRS! -Take my advice, I don't use it anyway. -Take two crows and caw me in the morning -Talk is cheap because Supply exceeds Demand. -Taxes are not levied for the benefit of the taxed. -Teamwork is essential. It gives them another target. -Ten weeks from Friday will be a pretty good day. -Thank you very little. -That ain't so good English! -That must be wonderful! I don't understand it at all. -That that is is not that that is not. -That was ZEN -- this is TAO -That'll be $67.50 CCCHHHHHIIIIINNNNGGGG!!!! -That's inches away from being millimeter perfect. -The Borg assimilated me & all I got was this stupid T-Shirt! -The Czech's in the mail. Sending Frenchman by FAX. -The French defense isn't... -The Hubbell works fine; all that stuff IS blurry! -The Lab called,..... Your brain is ready! -The Magic of Windows: Turns a 486 back into a PC/XT. -The Microsoft Motto: 'We're the leaders, wait for us!' -The PARITY CHECK is in the E-MAIL... -The Tour de France! -The UARTs won't take this speed, Captain -The Universe is a big place... perhaps the biggest -The Vatican Express Card. Don't leave Rome without it. -The backup's not over 'til the FAT table sings! -The ballot is stronger than the bullet. -The best cure for insomnia is to get a lot of sleep. -The best defense against logic is stupidity. -The best defense is to stay out of range. -The best substitute for experience is being sixteen. -The best way to keep friends is not to give them away. -The best way to win an argument is to be right. -The buck doesn't even slow down here! -The cause of problems are solutions! -The cost of feathers has risen... Now even DOWN is up! -The cost of living hasn't affected its popularity. -The cream rises to the top. So does the scum... -The days of the digital watch are numbered -The dentist said my wisdom teeth were retarded. -The dreadful burden of having nothing to do. -The evidence before the court is...INCONTROVERTIBLE! -The eyes are the mirror of the soul. -The first duty of a revolutionary is to get away with it -The first myth of management is that it exists. -The first rule of intelligent tinkering is save all parts! -The fish that escaped is the big one. -The further I go, the behinder I get. -The future isn't what it used to be. -The game's a little bit wide open again. -The gene pool has no lifeguard. -The hand that turneth the knob, opens the door. -The hangman let us down. -The hardest thing about time travel is the grammar. -The heart is wiser than the intellect... -The irony of life is that no one gets out alive... -The large print giveth and the small print taketh away. -The little engineer that could -The longer the title, the less important the job. -The man who begins many things finishes few. -The margin is very marginal. -The meek shall inherit the earth, if that's OK with you -The mind is like a parachute - it works only when open. -The moving cat sheds, and having shed, moves on... -The next thing to do is hang all the consultants. -The only thing shorter than a weekend is a vacation. -The option to override self-destruct expir@^%i@&$#NO CARRIER -The pen is mightier than the pencil. -The penalty for bigamy is having two mothers-in-law. -The pendulum has gone full circle. -The purpose of computing is insight, not numbers. -The rich get richer; the poor get babies. -The road to success is always under construction. -The score didn't really reflect the outcome. -The secret of the universe is~~*#~** FF * NO CARRIER -The shortest distance between two points is off the wall -The simple explanation always follows the complex solution -The sixth sheikh's sixth sheep's sick. -The soul would have no heart had the eyes no tears... -The superfluous is very necessary. -The thrill is gone, the thrill is gone baby -The universe is a spheroid region 705 meters in diameter... -The unnatural, that too is natural. -The way to a man's heart is through the left ventricle. -The weather is here, wish you were beautiful. -The whole world is about three drinks behind -The world is coming to an end. Please log off. -The worst thing about censorship is **************************. -The young know the rules, the old know the exceptions. -Then somebody spoke, and I went into a dream.... -There are 2 ways to handle women and I know neither. -There are many things I could say... -There are no atheists in the foxholes. -There is always a way, and it usually doesn't work. -There is an exception to every rule, except this one. -There is much Obiwan did not tell you. -There is no dark side of the moon. Really. -There is no finish line. -There is no remedy for fun but more fun! -There is no vaccine against stupidity. -There is something to be said about me: 'Wow!!' -There will be no last bus tonight. -There's a hot place with pitchforks waiting. -There's no future in time travel -There's no such thing as a free lunch, but you can always find someone willing to treat. -There's one in every car... You'll see. -There's one in every crowd and they always find me. -There's safety in numbers/When you learn to divide. -Thesaurus: ancient reptile with an excellent vocabulary. -They told me I was gullible ... and I believed them! -Things are not what they seem. -Think 'HONK' if you're a telepath. -Think hard now! Which one is Shinola? -This Charlie Brown must have been a very wise man. -This Country Needs Group Therapy. -This ain't no party...this ain't no disco... -This door is baroque; please call Bach later. -This is a Tagline mirror ][ rorrim enilgaT a si sihT -This is abuse. Arguments are down the hall. -This is just a hobby. Perfection is not required. Fun is. -This is not a fairing, it's a force field. -This is only a test. -This is our only tag line. -This isn't right. This isn't even wrong. -This line intentionally left unjustified. -This login session: $13.99, but for you $11.88 -This message has been UNIXized for your protection. -This message is SHAREWARE! To Register, send $5. -This message was typed on recycled phosphorous. -This mind intentionally left blank. -This program makes me look like a genius. -This sentence is false. -This tagline does not require Micro$oft Windows. -This tagline intentionally left blank. -This tagline is umop apisdn -This tagline only to be removed by the consumer. -This tagline was created from many little letters. -This tagline was reclaimed and is not yet stolen. -This tagline was written before a live studio audience. -Those who can't write, write manuals. -Those who can, do. Those who can't, simulate. -Those who can, do. Those who can't, supervise! -Those who live by the nit, die by the nit -Those without heads do not need hats. -Three can keep a secret, if two are dead. -Tilt your chair back, your breath is effecting my RAM! -Tilting at windmills hurts you more than the windmills. -Time flies like an arrow - Fruit flies like a banana -Time flies when you don't know what you're doing. -Time is an illusion, lunchtime doubly so. -Tis better to be hunter than hunted. -Tis better to have loved a short than to never have loved a tall. -Tis better to have loved and lost than just to have lost. -To be, or not to be, those are the parameters. -To boldly go and watch Star Trek re-runs. -To do nothing is also a good remedy. -To eat is human, to digest, divine. -To err is human, to eat Jello, is messy. -To err is human, to forgive is against company policy. -To err is human. To really screw up it takes a computer. -To err is human. To blame someone else is politics. -To err is human. To moo bovine -To every rule there is an exception, and vice versa. -To iterate is human, to recurse, divine. -To live in the hearts we leave behind, is not to die. -To live well, know the difference between good and evil. -To me personally, it's nothing personal to me. -To shoot a mime, do you use a silencer? -Today is Monday, cleverly disguised as Tuesday. -Today is National Existential Ennui Awareness Day. -Today is the first day of the rest of this mess. -Today is the tomorrow you worried about yesterday -Todays subliminal message is ' ' -Tolkien is hobbit-forming. -Tongue tied & twisted, just an earthbound misfit I. -Too bad stupidity isn't painful. -Too much is never enough. -Too much month at the end of the money. -Too much of a good thing is WONDERFUL. -Toto, I don't think we're in DOS anymore... -Touch if you must, Pay up if you bust. -Toys are made in heaven, batteries are made in hell. -Trees hit cars only in self-defence. -Trespassers will be shot, survivors will be shot again! -Tried to play my shoehorn... all I got was footnotes! -Trig..a..name...o...tree!!! -Truck Pulls: for people who cannot understand the WWF -Trust me -- I'm a Lawyer. -Truth is just another misconception. -Truthful: Dumb and illiterate. -Try to get back on topic, he said moderately. -Try to look unimportant, they may be low on ammo -Try? Try not. Do, or do not. There is no try. -Trying to think of a good tagline... -Tubby or not tubby, fat is the question! -Turn right here. No! NO! The OTHER right! -Turning floppies into hard drives. -Two Wrongs Don't Make A Right, But Three Lefts Do. -Two heads are more numerous than one. -Two most common elements: hydrogen, stupidity. -Tyre Shop sign - We Skid You Not. -UART what UEAT! -UNNAMED LAW: If it happens, it must be possible. -Uh, yeah...I MEANT to do that! -Ultimate Question Research Team -Unable to locate Coffee -- Operator Halted! -Unburdened by the rigors of coherent thought. -Unix and the world Unix with you; VAX and you VAX alone. -Unless you're the lead dog, the view never changes. -Unqualified superlatives are the worst of all. -Until people grow up, they have no idea what's cool -Use your MasterCard to pay your Visa bill. -Users, losers -- what's the difference? -Using yesterday's technology to solve today's problems, tomorrow -VLSI: 'Getting High On Low Voltage' -Vampires Against Mundane Poetry. -Variables won't; constants aren't. -Veni Vidi Visa: I came, I saw, I did a little shopping. -Verbosity leads to unclear, inarticulate things. -Volcano -- a mountain with hiccups. -Vote Democratic... It's easier than getting a job. -Vuja De - The Feeling You've Never Been Here -Vulcans have less fun. -Vultures only fly with carrion luggage. -W.A.R.P.: We Are Real Programmers. -WAITER! there's soup in my fly! -WARNING ... drinking tap water can kill your thirst! -WARNING: my messages are offensive to morons! -WINDOWS ERROR #004: Operator fell asleep while waiting. -WWhhaatt ddooeess dduupplleexx mmeeaann?? -WYGIWYD -What you got is what you deserved. -WYTYSYDG-What you thought you saw, you didn't get. -Waiter, there's no fly in my soup! - Kermit -Walk softly and carry a megawatt laser. -Walls impede my progress -Wanna flirt with disaster? Become a SysOp! -Want a LAUGH run a spell check on DSZ docs. -Want a jelly baby? -Want a stupid answer? Ask me anything! -Wanted: Volcano. Average size. Must be active. -War News: Saddam's army blown away by Thai hookers. -Warning: Whimsical when bored -Warning: Politicians can damage your wealth. -Warranty void if tagline removed. -Was today really Necessary? -Wash your face in the morning, neck at night. -Wasting time is an important part of living. -We all live in a yellow subroutine. -We are not a clone. -We are the people our parents warned us about -We don't care. We don't have to. We're Telecom... -We have here the latest in primitive technology. -We seem to have juxtaposed an impasse here -We should limit congressmen to two terms: one in Congress, one in prison -We take drugs very seriously at my house... -We were unanimous - in fact everyone was unanimous. -We'll give you piece de resistance and a tour de force -We're as similar as two dissimilar things in a pod. -We're lost, but we're making good time. -We're staying together for the sake of the cats. -Weeping, I wake; waking, I weep, I weep. -Welcome to Texas, now go home. -Welcome to the Church of the Holy Cabbage. Lettuce pray -Well cover me in egg & flour and bake me for 14 minutes -What are you doing?!? The message is over,GO AWAY! -What can you do for me? -What color is a chameleon on a mirror? -What could possibly go wrong. -What do batteries run on? -What do you mean that 2 years have passed?? -What do you think? -What does Santa do at a house with no chimney? -What does ignorant mean? -What does this red button do? -What else can you do at 3:00 am? -What garlic is to salad, insanity is to art. -What goes around usually gets dizzy and falls over. -What goes up has probably been doused with petrol. -What has four legs and an arm? A happy pitbull. -What's Irish and stays out all night? Paddy O'Furniture. -What's another word for 'thesaurus?' -What's brown and sticky? A stick! -When 911 won't work .357 will! -When in doubt, think. -When their numbers dwindled from 50 to 8, the dwarfs began to suspect 'Hungry' -When your opponent is down, kick him. -Where does weight go when you lose it? -Where in the world is Carmen San Diego? -Who cares how it plays in Peoria? -Who cares who's on board? -Who glued the cup to the table? -Who is 'they' anyway? -Whosoever diggeth a pit shall falleth therein. -Why am I asking all these things? -Why are Chinese fortune cookies written in English? -Why are you looking down here? The joke is above! -Why are you wasting time reading taglines? -Why aren't there many Hannukah specials on tv? -Why can't we just spell it orderves? -Why did you read this? -Why do people cry when they're sad? -Why do they tell us to watch 'The Today Show' tomorrow? -Why do we elect people and then become afraid of them? -Why do we read left to right yet turn pages right to left? -Why do you think they call it 'find'? -Why does it matter if we all put our pants on one leg at a time? -Why does the beginning of your sentence end up in the middle of mine? -Why don't ease, lease, and please sound alike? -Why don't tomb, comb, and bomb sound alike? -Why get even, when you can get odd? -Why is 'abbreviated' such a long word? -Why isn't 'palindrome' spelled 'palindromeemordnilap'? -Will Rogers never met a lawyer. -Will the sound of one hand clapping still turn off my TV? -Win if you can, lose if you must, but always cheat -Windows Error #F99 - CPU too tired to continue... -Windows N'T: as in Wouldn't, Couldn't, and Didn't. -Windows NT: Only 16 megs needed to play Minesweeper! -Windows NT: The world's only 80 megabyte Solitaire game! -Windows NT: Vapourware of the desperate and scared. -Windows error 000 : No errors found! [CLOSE] -Windows is *NOT* a virus. Viruses *DO* something! -Windows is for fun, Linux is for getting things done. -Windows is the best GUI - It always sticks! -Windows isn't CrippleWare -- it's 'Functionally Challenged'. -Windows only crashes itself under Linux. Not the whole machine. -Windows would look better with curtains. -Windows: The answer to a question nobody has ever asked. -Windows: an Unrecoverable Acquisition Error! -WindowsNT: From the makers of Doublespace -Wisdom is knowing what to do with what you know. -Wit is cultured insolence. -Without Time, everything would happen at once. -Without music, life would be a mistake. -Women - can't live with 'em and no resale value... -Women do come with instructions; ask them. -Women get minks the same way minks get minks. -Women who seek to be equal to men lack ambition. -Women! Can't live with 'em and no resale value. -Work off excess energy. Steal something heavy -World ends today at 9:30 pm! Film at 11:00... -Worry : The interest paid on trouble before it's due -Worst-dressed sentient being in the known universe -Would I ask you a rhetorical question? -Yes my son, long ago mail was read 1 packet at a time. -You buttered your bread, now lie in it. -You can name your salary here. I call mine Fred. -You can tune a guitar, but you cant tuna fish. -You can't have everything...where would you put it? -You hit the nail right between the eyes. -You're it. -You've got to be trusted by the people that you lie to. -Young gorillas are friendly, but they soon learn. -Your E-Mail has been returned due to insufficient voltage! -Youth is a gift of nature. Age is a work of art. -Yuk, what kind of dumb menu system is that? Oh, so that is Windows! -Zen T-Shirt: Enlightenment Available - Enquire Within -[DISCLAIMER: my fingers are epileptic] -[If you can't hear me, it's because I'm in parentheses] -hAS ANYONE SEEN MY cAPSLOCK KEY? -Serenity through viciousness. -FUN is never having to say you're SUSHI!! -Include me out. -YOW!! I'm in a very clever and adorable INSANE ASYLUM!! -'That boy's about as sharp as a pound of wet liver' -- Foghorn Leghorn -Pardon me while I laugh. -Vegeterians beware! You are what you eat. -Marriage is the sole cause of divorce. -'From there to here, from here to there, funny things are everywhere.' -- Dr. Seuss -You'll be sorry... -The world is coming to an end. Please log off. -UH-OH!! We're out of AUTOMOBILE PARTS and RUBBER GOODS! -I used to get high on life but lately I've built up a resistance. -Paranoia is heightened awareness. -The things that interest people most are usually none of their business. diff --git a/blootbot/files/sample/blootbot.chan b/blootbot/files/sample/blootbot.chan deleted file mode 100644 index b0fe8b6..0000000 --- a/blootbot/files/sample/blootbot.chan +++ /dev/null @@ -1,96 +0,0 @@ -#v1: blootbot -- infobot -- written Sat Jan 21 06:17:24 2006 - -#botpark - -OnJoin - +RootWarn - +autojoin - -#debian-bots - +News - +RootWarn - +chanlimitcheck - chanlimitcheckInterval 10 - chanlimitcheckPlus 10 - factoidDeleteDelay 7 - ircTextCounters heh hah :) ? hi lol - +joinfloodCheck - limitcheckInterval 10 - limitcheckPlus 10 - newsDefaultExpire 7 - +newsKeepRead - +newsNotifyAll - rootWarnMode aggressive - -_default - +BZFlag - +Debian - +DebianExtra - +Dict - +Exchange - +Factoids - +HTTPDtype - +Kernel - +Math - +OnJoin - +Plug - +Quote - +Rss - +Search - +Topic - +Units - +UserInfo - +W3Search - +Weather - +Zippy - addressCharacter ~ - +allowConv - +allowTelling - +babelfish - +botmail - +case - +cookie - +countdown - debianRefreshInterval 7 - +dice - +dns - +factoidArguments - factoidSearch $chan _default - floodMessages 10:30 - floodRepeat 2:10 - +freshmeat - freshmeatRefreshInterval 24 - +insult - +karma - +lart - +limitcheck - +log - maxListReplyCount 15 - maxListReplyLength 400 - +md5 - minVolunteerLength 50 - +nickometer - +pager - +piglatin - randomFactoidInterval 60 - randomQuoteInterval 60 - +reverse - +scramble - +sed - +seen - seenFlushInterval 60 - seenMaxDays 90 - +seenStats - +seenStoreAll - sendNoticeLimitBytes 1000 - sendNoticeLimitLines 3 - sendPrivateLimitBytes 1000 - sendPrivateLimitLines 3 - sendPublicLimitBytes 1000 - sendPublicLimitLines 3 - +slashdot - +spell - +tell - +wtf - +zfi - +zsi - diff --git a/blootbot/files/sample/blootbot.config b/blootbot/files/sample/blootbot.config deleted file mode 100644 index d3ccffa..0000000 --- a/blootbot/files/sample/blootbot.config +++ /dev/null @@ -1,227 +0,0 @@ -# blootbot configuration file, modify it to your own taste. blootbot reads -# this file from files/blootbot.config so it should be moved there. - -##### -# Basic IRC info -##### -set ircNick blootbot -set ircUser blootbot -set ircName blootbot experimental bot -# if your irc network requires a password to get on the servers -#set ircPasswd SomePassword -set ircUMode +iw - -# if not using a virtualhost set to 0.0.0.0 -# otherwise IRC::Connection might try localhost which will NOT work -###set ircHost vh.virtualhost.org -set ircHost 0.0.0.0 - -set owner OWNER - -# nickserv/chanserv support. -###set nickServ_pass PASSWORD -###set chanServ_ops #chan1 #chan2 - -# default quit message. -set quitMsg adios amigos - -# path to a temporary directory which blootbot can use. -set tempDir /tmp - -##### -# Factoid database configuration -##### - -# [str] Ability to remember/tell factoids -# none -- disable. -# mysql -- ... -# SQLite -- SQLite (libdbd-sqlite-perl) (might be version 2 or 3) -# SQLite2 -- SQLite (libdbd-sqlite-perl) (force version 2) -# pgsql -- postgresql (SUPPORTED and TESTED!!!) -### REQUIRED by factoids,freshmeat,karma,seen,... -set DBType mysql - -# [str] SQLite filename prefix // MYSQL/PGSQL database. -# eg: blootbot-factoids, blootbot-seen -# eg: /var/db/mysql/blootbot/factoids.* -set DBName blootbot - -# [str] Hostname of database server (unset for SQLite) -set SQLHost localhost - -# [str] SQL user allowed to insert,update,delete stuff from tables. (unset for SQLite) -set SQLUser blootbot - -# [str] SQL password. (unset for SQLite) -set SQLPass PASSWORD - -# [str] SQL debug file. "-" for stdout may work on some platforms -###set SQLDebug SQL_debug.log - -##### -# Logfile configuration -##### - -# [file] where to put logging info. comment out to disable. -#set logfile log/$ircUser.log -set logfile log/ - -# [str] Type of logging. -# DAILY -- Create a new log each day. -# DEFAULT -- One continuous log file. -set logType DAILY - -# [int] Maximum log size, if logfile is defined, in bytes. -set maxLogSize 10000000 - -##### -# Factoid-related configuration -##### - -# [bool] Factoid support. -set factoids true - -# [days] if not 0, number of days until factoid is deleted for good. -set factoidDeleteDelay 0 - -# [int] maximum length of factoid key. -set maxKeySize 32 - -# [int] maximum length of factoid value. -set maxDataSize 450 - -# [str] when should the bot bother learning new factoids. -# ADDRESSED -- only learn when addressed. -# HUNGRY -- learn irrelevent of addressing. this will catch -# _everything_, use at your own risk. -set learn ADDRESSED - -# [str] different behaviour with URLs. -# REQUIRE -- means it will need to be a url type (e.g. file:, http:) -# OPTIONAL -- will take anything -# REJECT -- will not accept any urls. this makes it easy to -# run 2 with different nicks and styles. -# ^^^ what's the point of this??? -set acceptUrl OPTIONAL - -# [bool] profanity checking. -set profanityCheck false - -# [0/1] tell so-and-so about such-and-such of a factoid. -set allowTelling 1 - -# [str] other bots to ask for factoids which they may have. -#set friendlyBots url purl script mrapi - -##### -# Factoid related and unrelated features, mainly Extras. -##### - -# [str] addressing is when you name the bot. FIXME: -# REQUIRE -- the bot only does something if addressed. -# OPTIONAL -- the bot responds (does not learn) irrelevent of -# addressing. -set addressing REQUIRE - -# [str] how the bot should send messages. -# PRIVATE -- reply to private messages only, rejecting public msgs. -# DEFAULT -- reply to public _and_ private queries. -set talkMethod DEFAULT - -# [str] how long the output string should be before it is changed from -# public to private. -# "+" before bot commands overrides this option temporarily. -###set minLengthBeforePrivate 192 - -# [0/1] allow people outside any channels the bot is on to use the bot -# for factoids and commands. -set disallowOutsiders 1 - -# [int] Amount of time for auto-ignore (flooding) to expire. -set ignoreAutoExpire 5 - -# [int] Amount of time for forced-online ignore to expire. minutes. -set ignoreTempExpire 60 - -##### -# Internal (simple) bot commands -##### - -# [0/1] Forking... disable for non-nix OS or to reduce mem usage. -# Disabling should make the bot work on Win32 and MacOS. -set forking 1 - -# [int] Backlog... ideal to see what happened to the bot on console. -# maximum number of lines to backlog. -set backlog 24 - -##### -# Extra features -##### - -# [str] anything which requires LWP + http proxy. -###set httpProxy http://HOSTNAME:PORT/ - -# [0/1] countdown to specific dates -set countdown true - -# [0/1] Debian file and package search. -# FIXME: should be a channel option -set Debian true - -# [0/1] Freshmeat -set freshmeat false -# [int] how often to update the freshmeat table, in hours. -set freshmeatRefreshInterval 24 - -# [bool] if factoid does not exist, check freshmeat for it. -set freshmeatForFactoid false - -# [0/1] Uptime logs -set Uptime true - -##### -# Miscellaneous configuration options -##### - -# [int] Display a bit too much info about stuff. -# 0 -- disable. -# 1 -- standard. -# 2 -- extra. -set VERBOSITY 1 - -# [0/1] Warn messages. -set WARN 1 - -# [0/1] Debugging messages. -set DEBUG 0 - -# [0/1] Work In Progress... -set WIP 0 - -# strict perl? -set useStrict 1 - -# debugging... -###set DumpVars 1 -###set dumpvarsAtExit 1 -# log to specific file or global log file. -###set dumpvarsLogFile dumpvars.log -# more debugging -###set DumpVars2 1 -###set symdumpLogFile log/dumpvars2.log - -# [str] Interface: [IRC/CLI] -# IRC -- Internet Relay Chat -# CLI -- Command Line Interface -set Interface IRC - -# [0/1] Show topic author (troubled) -# If 1, topics managed with !topic add foo will show the nick in ()'s -# If 0, the nick of the creator will be recorded for !topic list, but not shown in the topic itself -set topicAuthor 1 - -#### -# Now modify blootbot.chan for per-channel specific configuration see -# sample.chans for info. -#### diff --git a/blootbot/files/sample/blootbot.countdown b/blootbot/files/sample/blootbot.countdown deleted file mode 100644 index f127682..0000000 --- a/blootbot/files/sample/blootbot.countdown +++ /dev/null @@ -1,12 +0,0 @@ -# countdown file. -20001225 christmas Christmas -20000914 olympics Opening ceremony of Olympics in Sydney, Australia -20000704 america Independence Day -20000501 potato Proposed release of Debian GNU/Linux Potato 2.2 -20000420 2.4 Hopeful debut of 2.4.0 kernel -20000315 xfree4.0 XFree86 4.0 core release -20000217 win2k Evil Empire's Release of deadly OS -20000126 australia Australia Day -20000119 crusoe Transmeta comes out of hiding -20000115 freeze Debian (GNU/Linux) Potato version 2.2 stabilization begins -20000101 y2k Year 2000 diff --git a/blootbot/files/sample/blootbot.servers b/blootbot/files/sample/blootbot.servers deleted file mode 100644 index 648b010..0000000 --- a/blootbot/files/sample/blootbot.servers +++ /dev/null @@ -1,7 +0,0 @@ -### -# blootbot.servers: line separated list of servers to connect to -### - -irc.freenode.net -irc.home.org -irc.linux.com diff --git a/blootbot/files/sample/blootbot.users b/blootbot/files/sample/blootbot.users deleted file mode 100644 index 59f7b1e..0000000 --- a/blootbot/files/sample/blootbot.users +++ /dev/null @@ -1,22 +0,0 @@ -#v1: blootbot -- blootbot -- written Mon Feb 28 23:46:48 2005 - -_default ---FLAGS amrt ---HOSTS *!*@* - -local ---FLAGS Aemnorst ---HOSTS local!local@local ---PASS xxfxfIfoJHdYg - -timriker ---FLAGS Aemnorst ---HOSTS *!~timr@TimRiker.active.supporter.pdpc ---PASS xxfxfIfoJHdYg - -xk ---FLAGS emnorst ---HOSTS *!xk@example.com ---HOSTS *!xk@superbox.home.org ---PASS 5K/rmJPzwxJhU - diff --git a/blootbot/files/unittab b/blootbot/files/unittab deleted file mode 100644 index d4f7a0e..0000000 --- a/blootbot/files/unittab +++ /dev/null @@ -1,668 +0,0 @@ -# -# Unit defintions -# 18 May 2001 M-J. Dominus <mjd-perl-units+@plover.com>. -# This file is in the PUBLIC DOMAIN. -# All rights abandoned. -# -# If you discover definitions of units that do not appear in this -# file, you are invited to mail them to mjd-perl-units+@plover.com, so -# that I can include them in a future version. Please include the -# date of this file, 18 May 2001, with all such submissions. - -# If a unit is defined as `***', that means -# it has no definition because it is a fundamental unit. - -# http://perl.plover.com/units/unittab - -# Fundamental units: -# Seven instrinsic SI units: -gram *** -meter *** -# Tim Riker <Tim@Rikers.org> adds metre alias -metre meter -second *** -ampere *** -candela *** -Kelvin *** -mole *** -# Two supplementary units -radian *** -steradian *** -# Some miscellany -dollar *** -bit *** -sheet *** # Of paper -turn *** # Of coiled wire - -# DIMENSIONLESS -pi 3.1415926535897932386 -two 2 -half 1|2 -e 2.718281828459045 # Why did I put this in? Oh, I don't know. -Neper 1 # Unit of logarithmic ratio -Np Neper -# Would it be better to make this a fundamental unit? -bel .868588963 Np # 2/ln(10) actually -B bel -dB decibel - -# LENGTH -m meter -km kilometer -cm centimeter -mm millimeter -micron micrometer -inch 2.54 cm # This is the official definition and is exact -mil milliinch -in inch -barleycorn 1/3 inch # Tim Riker <Tim@Rikers.org -inches inch # plural -foot 12 inch -ft foot -feet foot -yard 3 feet -yd yard -mile 5280 feet -mi mile -#nautical 1.151 # For `nautical mile' -nautical 1.150779447892 -statute 1 -# pilots need this :) -nm 1 nautical mile -sm 1 statute mile -parsec 1.91615e13 mi -#parsec 3.08568025e16 m # better? -# light year will be implied by `year' and `light' below -fathom 6 ft -cable 120 fathoms -league 3 mi -bolt 25 yd # Of cloth; bolt length varies from bolt to bolt - # 25 yd is typical -cubit 18 in -ell 45 in # More or less standard, although other ells - # have also been used. -hand 4 in -palm 3 in -span 9 in -pace 2.5ft -astronomicalunit 92.9 megamiles # Is this exact? -au astronomicalunit -rope 20 ft -skein 360 feet - -# Surveyor's -furlong 1|8 mi -chain 1|10 furlong -rod 1|4 chain -link 1|100 chain - -# Typographic -point .013837 in -pt point -bigpoint 1|72 in -pica 12 pt -didot 1238|1157 pt -dd didot -cicero 12dd # TeX likes to abbreviate this to cc, but cc is cubic centimeter -scaledpoint 1|65536 pt # Internal to TeX -sp scaledpoint - - - -# AREA -are (10 m)2 # Implies `hectare' -acre chain furlong # Now you know why an acre is the size it is -rood 1|4 acre -township 36 mi2 # Who uses these? -barn (1.0E-12 centimeter)2 # Particle physics -board 144 in3/ft # Implies `board feet' - -# VOLUME -cc cm3 -liter (decimeter)3 -ml milliliter -stere m3 -floz 29.573 ml # `floz' means `fluid ounce', which is different - # from `ounce', which is a measurement of mass. - # See `pound' below for more details. -fldram 1|8 floz -minim 1|60 fldram -cup 8 floz -cu cup -gill 1|2 cup -pint two cups -quart two pints -pottle two quarts # Yup! -gallon two pottles -qt quart -gal gallon -tablespoon 1|2 floz -tbsp tablespoon -teaspoon 1|3 tbsp -tsp teaspoon -cordfoot 16 ft2 # NOT the same as `cord foot'. -cordfeet cordfoot -cord 8 cordfeet -# Barrels are complicated. `Barrel' here means `U.S. liquid barrel'. -barrel 31.5 gal -bbl barrel -hogshead two barrels -butt two hogsheads -tun two butts -firkin 9 gal # American firkin, not British firkin -perch 24.75 ft3 # Masonry -puncheon 84 gal -# Following units contributed 20011217 Thomas R Wyant III -fifth 1|5 gallon -magnum 2.5 fifth -jeroboam 4 fifth -rehoboam 7.5 fifth -methuselah 10 fifth -shalmanazar 14 fifth -balthazar 20 fifth -nebuchadnezzar 25 fifth - -# Delightful British liquid volumes; they all begin with `brit'. -britfloz 28.41225 ml -britminim 1|480 britfloz -britdrachm 1|8 britfloz -drachm britdrachm # U.S. drachm is spelled `dram'. -britgill 5 britfloz # five, NOT four. -britnoggin britgill -noggin britnoggin # Yeah, as though anyone else would have a `noggin.' -britpint 4 britgill -britpt britpint -britquart 2 britpint -britqt britquart -britgallon 4 britquart -britgal britgallon -britpeck 2 britgal -britfirkin 9 britgal -britkilderkin two britfirkins -kilderkin britkilderkin # kilderkin is British only -britbucket 4 britgal # That's `britbucket,' not `bit bucket'. -bucket britbucket # Buckets are brit only. -britlast 2909.414 liters -last britlast - -# Dry volume -dry 1.164904862579 # For `dry pint,' `dry quart,' etc. -peck 8 dry quarts -bushel 4 pecks -bu bushel -seam 8bu -bag 3bu - -imperial 1.201 # For `imperial pint,' etc. - -# MASS (also WEIGHT) -# -# To avoid confusing the end user, we will pretend that `pound' is -# a unit of mass, interconvertible with `grams'. If you want -# pounds of force, see `lbf,' below. In this section, `pound' -# really means `mass of an object that weighs one-pound at the surface -# of the Earth.' That is, in this program, `slug' has its usual -# meaning, and `pound' is synonymous aith `slug'. -g gram -kg kilogram -metricton kilokilogram -tonne metricton -mg milligram -grain 64.79891 mg -ounce 437.5 grains -oz ounce -pound 16 oz -lb pound -slug lb -hundredweight 112 lb # This is the `long' hundredweight, analagous to - # the long ton. There is also a `short' hundredwight, - # but it's just a hectlb, so I put this one in instead. -cwt hundredweight -quarter 5 cwts -longton 20 cwt -#ton longton # use shortton my default Tim Riker <Tim@Rikers.org> -short 100|112 # Convert long tons, cwts, and quarters to short. -shortton short longton -ton short longton # the american ton, see metriton and longton -stone 14 lb -cental 100 lb -wey 252 lb -# Obscure apothecaries' measures -scruple 20 grains -dram 3 scruples -apothounce 480 grains -apothoz apothounce -apothpound 12 apothoz -apothlb apothpound -# Troy measures (for gold and precious stones) -pennyweight 24 grains -troyoz 480 grains # We can't define `troy' as a constant, - # because there are 16 oz in a lb, but only - # 12 troyoz in a troylb, so at least one of - # `troy oz' or `troy lb' would be wrong. -troylb 12 troyoz -carat 3.08647 grain # Metric version. Is this useful? -atomicmassunit 1.6605402e-27 kg # NIST 19990301 (+/- 0.10e-33 kg) -amu atomicmassunit -quintal 100kg # Metric quintal. Wasn't there another quintal? -elvis 255lb # At the time of his death, the King weighed 255 lb. - -# TIME -sec second -s second -minute 60 sec -min minute -hour 60 min -hr hour -day 24 hrs -dy day # This will denote mean solar days -siderealday 0.99726957 dys -week 7 days -wk week -month 30 days -lunarmonth 29.530588 days # Mean solar days -meanmonth 730 hours -mo month -tropicalyear 365.24219 dys # Mean solar days -siderealyear 365.25636 dys # Mean solar days -leapyear 366 dys # Mean solar days -calendaryear 365 dys # Mean solar days -gregorianyear 365.2425 dys -year tropicalyear # Correct on average for most calculations -yr years -fortnight two weeks -decade 10 years -century 100 years -millennium 1000 years -millennia millennium -centuries century -beat 1|1000 day # Swatch Internet Time (``Fuck the Sun'') -# Velocity -knot 1 nautical mi/hour -mph 1 mi/hr - -# SCIENTIFIC -# -# Electromagnetic items, work, force, energy. -# -# Velocity -c 299792458 m/s # NIST 19990301 EXACT -light c # Implies `light year' - - -# Absolute temperature -kelvin Kelvin -K Kelvin -Rankine 5|9 K # This is a very funny unit -Ra Rankine - -# Amount of substance -mol mole -Avogadro 6.0221367e23 -avogadro Avogadro -molecule 1 mole per Avogadro # 1 mole is an Avogagro-number of molecules - -# Current -# The Ampere is fundamental here, defined as the constant current -# which, if maintained in two straight parallel conductors of infinite -# length, of negligible circular cross-section, and placed 1m apart in -# vacuum, would produce between these conductors a force equal to 2e-7 -# newtons per meter of length. -Ampere ampere -amp ampere -abampere 10 amps -abamp abampere -statampere 3.335635e-11 abamperes -statamp statampere - -# What is this called? Is it capitalized? Is there an abbreviation? -gilbert 0.79577472 ampere turns - -# Electrostatic charge -Coulomb ampere sec -coulomb Coulomb -coul Coulomb -C Coulomb -electron 1.60217733e-19 C # Charge on the electron; implies electron-volts -e electron -abcoulomb 10C -statcoulomb 3.335635e-11 abcoulomb - - -# Force -Newton kg m/s2 -newton Newton -N newton -dyne g cm/s2 -grav 9.8 m/s2 # Acceleration due to gravity -gee grav -# Actually the accleration varies with altitude and latitude, -# from 9.78039 m/s2 at the equator to 9.83217 m/s2 at the poles. -# This mean value corresponds to a latitude of about 38 degrees. -lbf lb grav - -# Pressure -Pascal N/m2 -pascal Pascal -Pa pascal -atmosphere 101325 N/m2 # NIST 20010518 EXACT -atm atmosphere -bar megadyne/cm2 # Implies `millibars' -mercury 1|760 atm/mm # Implies `mm mercury' and `inches mercury' -hg mercury -torricelli mm hg -torr torricelli -water .0295 atm/ft # Implies `feet water' -barye dyne/cm2 -air 6.6083e-5 atm/foot # At 60 deg.F; Implies `feet air' - -# Work and energy -Joule newton-meter -joule Joule -J joule -footpound ft-lbf # foot-pound won't work, because `pound' is a mass -calorie 4.186 J -cal calorie -kcal kilocalorie -britishthermalunit 1054.8 J -btu britishthermalunit -erg dyne-cm -# Kilowatt-hour (kWh) will be implied by `Watt'. - - -# Power -Watt J/sec -watt Watt -W Watt -horsepower 550 ft-lbf/s - -# Electric potential -Volt W/amp -volt Volt -V Volt -abvolt 1|100 microvolt -statvolt 2.997930e10 V - -# Frequency -cycle 1 # For `cycles per second' -Hertz cycles per second -Hz Hertz -hz Hz - -# Inductance -Henry volt s/amp -henry Henry -H Henry -abhenry 1.0e-9 henry -Henries Henry # For plural -henries Henry -stathenry 8.987584e11 henries -stathenries stathenry - -# Etc. -Weber volt s -weber Weber -Wb weber -Tesla Wb/m2 -tesla Tesla -T tesla -Oersted 1|4 pi kiloamp/m -oersted Oersted -Oe oersted -Maxwell 1.0e-8 Wb -maxwell Maxwell -Mx Maxwell -Gauss 1.0e-4 T -gauss Gauss -# We won't use G for Gauss because it is more important to -# use it for the universal gravitational constant - -# Capacitance -# `farad' is *not* an abbreviation for `Faraday' as far as I can tell. -farad amp sec / volt -F farad -abfarad 1.0e9 farad -statfarad 1.112646e-13 farad - -# Resistance -Ohm volt/amp -ohm Ohm -abohm 1.0e-9 ohm -statohm 8.987584e11 Ohms - -# Conductance -mho 1/ohm -abmho 1/abohm -Siemens mho -siemens Siemens - -# Misc -Angstrom 1.0e-10 m -angstrom Angstrom -G 6.67259e-11 N m2/kg2 # Newton gravitational constant NIST19990301 -lightyear light year # Common abbreviation -eV e V # Electron volts -ev eV -kev kiloeV -Mev megaeV -Gev gigaeV -Tev teraeV -energy c2 # You can ask for `1 gram energy' and get - # the amount of energy equivalent to - # 1 gram according to e=mc2. - # Check: 1amu energy == 931.16 Mev? -Franklin (10/c) C cm/sec -Fr Franklin -franklin Franklin -Biot 10 amp -Bi Biot -biot Biot - -# Viscosity - Maybe someone who understands this better can check. -poise g/(cm s) # Named after M. Poiseuille -rhe 1/poise -reyn (lbf s)/in2 -# Kinematic viscosity = viscosity per unit density -stoke cm2/s - -# Refrigeration - Maybe someone who understands this better can check. -refrigeration 288000 btu/ton -ice tons refrigeration / 2009.1 lb - -# Light -# The candela is fundamental here. Prior to 1979, it was defined as -# the luminous intensity of a black body at the temperature of -# solidification of platinum, whose radiating surface is 1/60 cm2. It -# is now the luminous intensity, in a given direction, of a source -# that emits monochromatic radiation of frequency 540e12 Hz and that -# has a radiant intensity in that direction of 1|683 W/sr -cd candela -sr steradian -lumen candela sr -lm lumen -lux lm/m2 -lx lux -candlepower 12.566370 lumens -candle candela # ``International standard candle'' -Hefner 0.90 candles # This was the German standard in early C20. -hefner Hefner -Lambert lm/cm2 -lambert Lambert -footcandle lm/ft2 # NOT the same as foot-candle. -phot 1.0e4 lx -stilb candle/m2 # Same as a pi lambert - -# Various important physical constants -# I got this stuff from physics.nist.gov on 19990301. -h 6.6260755e-27 erg-sec # Planck's constant -hbar h/(2 pi) -plancklength 1.61605e-35 m -planckmass 2.17671e-8 kg -plancktime 5.39056e-44 sec -# Let's reserve `Planck' for a while longer until I can decide if -# they'd be useful in `planck time' etc. -permeability 4*pi*1.0e-7 H/m # Magnetic permeability of vacuum constant -permittivity 8.854187817e-12 F/m # Electric permittivity of vacuum constant -protonmass 1.6726231e-27 kg -neutronmass 1.6749286e-27 kg -electronmass 9.1093897e-31 kg -finestructure 7.29735308e-3 # Rl -# Electron charge is up above under `electrostatic'. -# There's no reason to get too obscure here because if someone wants -# they can make up an `obscure physical constants' file that -# physiscists could load in if they wanted to. So I've omitted stuff -# like the magnetic moment of the muon. - -# ANGULAR -rad radian -circle 2 pi radians -revolution circle # For revolutions / sec -rev revolution -rpm revolutions per minute -quadrant 1|4 circle -degree 1|360 circle -arcminute 1|60 degree -arcsecond 1|60 arcminute -arcmin arcminute -arcsec arcsecond -sphere 4 pi steradians -grade 1|100 quadrant -grad grade - -# PAPER -quire 50 sheets -ream 10 quires - -# INFORMATION -byte 8 bits -nybble half byte -kbyte 1024 bytes # `kilobyte' means 1000 bytes -# Don't use `K'; that's for Kelvins. -kb kbyte -Kb kbyte -KB kbyte -mbyte 1024 kbytes # `megabyte' means 1000000 bytes -meg mbyte -kbit 1024 bits -Kbit kbit -mbit 1024 kbits -Mbit mbit -baud bit/sec # Not strictly correct - -# MONEY -# -# Conversions accurate only as of 25 November 1996. -# -$ dollar -usdollar $ -usd $ -us$ $ -$us $ -US$ $ -$US $ -cent 1|100 $ -Australia.dollar 0.8123$ -AUS$ Australia.dollar -Austria.schilling 0.09438$ -Belgium.franc 0.03223$ -Brazil.real 0.9709$ -British.pound 1.681$ -pound.sterling British.pound -sterling British.pound -Canada.dollar 0.7468$ -Can$ Canada.dollar -Cayman.currency 1.22$ -Denmark.krone 0.173$ -krone Denmark.krone -EuropeanCommunityUnit.ECU 1.278$ -ECU EuropeanCommunityUnit.ECU -ecu ECU -Finland.markka 0.2203$ -markka Finland.markka -France.franc 0.1963$ -franc France.franc -Germany.mark 0.6647$ -DM Germany.mark -Deutschmark DM -mark DM -Greece.drachma 0.004216$ -drachma Greece.drachma -HongKong.dollar 0.1294$ -HK$ HongKong.dollar -India.rupee 0.02797$ -rupee India.rupee -Ireland.punt 1.684$ -punt Ireland.punt -Israel.shekel 0.3623$ -shekel Israel.shekel -Italy.lira 0.0006655$ -Japan.yen 0.008976$ -yen Japan.yen -Kenya.shilling 0.02376$ -Malaysia.dollar 0.397$ -Mexico.peso 0.1269$ -peso Mexico.peso -Morocco.dirham 0.1248$ -dirham Morocco.dirham -Netherlands.guilder 0.5924$ -guilder Netherlands.guilder -NewZealand.dollar 0.7153$ -NZ$ NewZealand.dollar -Norway.krone 0.1576$ -krone Norway.krone -Portugal.escudo 0.006577$ -escudo Portugal.escudo -Senegal.CFAfranc 0.002019$ -SouthAfrica.rand 0.2169$ -rand SouthAfrica.rand -Spain.peseta 0.007896$ -peseta Spain.peseta -Sweden.krona 0.1513$ -krona Sweden.krona -Switzerland.franc 0.788$ -swissfranc Switzerland.franc -Swissfranc Switzerland.franc -Turkey.lira 1.3e-05$ -# Old-style Brit money. Did I omit anything interesting? -sovereign sterling -shilling 1|20 sterling -penny 1|12 shilling -pence penny -farthing 1|4 penny -hapenny half penny -twopence two pence -tuppence two pence -thruppence 3 pence -threepence 3 pence -sixpence 6 pence -crown 5 shillings # Implies `half crown' -guinea 21 shillings -florin 2 shillings - - -# 18th century French coinage. References: -# http://home.nordnet.fr/~jlmorel/mesures.html and reverse-engineered -# from The Three Musketeers -# 20011227 Thomas R Wyant III -livre franc ### 3 Musketeers has francs! - ### Now, you too can convert Louis d'Or to U.S. Dollars! -sou 1|20 livre -crown 3 livres # It's ecu in French, not to be confused with ECU. -pistole 10 livres -double 2 # 3 Musketeers refers to double pistoles, so ... -louis 24 livres -### Now if only I had good definitions for reals and doubloons ... - - -# For `register tons' -register 100 ft3/ton -registerton register ton - -# What's missing? -# bequerel (nucleotide radioactivity): Bq = k/s k=1?? -# gray (absorbed dose): Gy = k J/kg k=1?? -# sievert (dose equivalent): Sv = k J/kg k=1?? -# curie: Ci = 3.3e10 Bq -# roentgen: R = 2.58e-4 C/kg -# rad: rad = centigray -# rem: rem = centisievert diff --git a/blootbot/patches/Google.pm b/blootbot/patches/Google.pm deleted file mode 100644 index 04f586e..0000000 --- a/blootbot/patches/Google.pm +++ /dev/null @@ -1,335 +0,0 @@ -########################################################## -# Google.pm -# by Jim Smyser -# Copyright (C) 1996-1999 by Jim Smyser & USC/ISI -# $Id: Google.pm,v 2.20 2000/07/09 14:29:22 jims Exp $ -########################################################## - - -package WWW::Search::Google; - - -=head1 NAME - -WWW::Search::Google - class for searching Google - - -=head1 SYNOPSIS - -use WWW::Search; -my $Search = new WWW::Search('Google'); # cAsE matters -my $Query = WWW::Search::escape_query("Where is Jimbo"); -$Search->native_query($Query); -while (my $Result = $Search->next_result()) { -print $Result->url, "\n"; -} - -=head1 DESCRIPTION - -This class is a Google specialization of WWW::Search. -It handles making and interpreting Google searches. -F<http://www.google.com>. - -This class exports no public interface; all interaction should -be done through L<WWW::Search> objects. - -=head1 LINUX SEARCH - -For LINUX lovers like me, you can put Googles in a LINUX only search -mode by changing search URL from: - - 'search_url' => 'http://www.google.com/search', - -to: - - 'search_url' => 'http://www.google.com/linux', - -=head1 SEE ALSO - -To make new back-ends, see L<WWW::Search>. - -=head1 HOW DOES IT WORK? - -C<native_setup_search> is called (from C<WWW::Search::setup_search>) -before we do anything. It initializes our private variables (which -all begin with underscore) and sets up a URL to the first results -page in C<{_next_url}>. - -C<native_retrieve_some> is called (from C<WWW::Search::retrieve_some>) -whenever more hits are needed. It calls C<WWW::Search::http_request> -to fetch the page specified by C<{_next_url}>. -It then parses this page, appending any search hits it finds to -C<{cache}>. If it finds a ``next'' button in the text, -it sets C<{_next_url}> to point to the page for the next -set of results, otherwise it sets it to undef to indicate we''re done. - - -=head1 TESTING - -This module adheres to the C<WWW::Search> test suite mechanism. - -=head1 AUTHOR - -This backend is written and maintained/supported by Jim Smyser. -<jsmyser@bigfoot.com> - -=head1 BUGS - -Google is not an easy search engine to parse in that it is capable -of altering it's output ever so slightly on different search terms. -There may be new slight results output the author has not yet seen that -will pop at any given time for certain searches. So, if you think you see -a bug keep the above in mind and send me the search words you used so I -may code for any new variations. - -=head1 CHANGES - -2.21.1 -Parsing update from Tim Riker <Tim@Rikers.org> - -2.21 -Minor code correction for empty returned titles - -2.20 -Forgot to add new next url regex in 2.19! - -2.19 -Regex work on some search results url's that has changed. Number found -return should be right now. - -2.17 -Insert url as a title when no title is found. - -2.13 -New regexp to parse newly found results format with certain search terms. - -2.10 -removed warning on absence of description; new test case - -2.09 -Google NOW returning url and title on one line. - -2.07 -Added a new parsing routine for yet another found result line. -Added a substitute for whacky url links some queries can produce. -Added Kingpin's new hash_to_cgi_string() 10/12/99 - -2.06 -Fixed missing links / regexp crap. - -2.05 -Matching overhaul to get the code parsing right due to multiple -tags being used by google on the hit lines. 9/25/99 - -2.02 -Last Minute description changes 7/13/99 - -2.01 -New test mechanism 7/13/99 - -1.00 -First release 7/11/99 - -=head1 LEGALESE - -THIS SOFTWARE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED -WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF -MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. - - -=cut -#' - - -##################################################################### - -require Exporter; -@EXPORT = qw(); -@EXPORT_OK = qw(); -@ISA = qw(WWW::Search Exporter); -$VERSION = '2.21.1'; - -$MAINTAINER = 'Jim Smyser <jsmyser@bigfoot.com>'; -$TEST_CASES = <<"ENDTESTCASES"; -# Google looks for partial words it can find results for so it will end up finding "Bogus" pages. -&test('Google', '$MAINTAINER', 'zero', '4036e7757s5', \$TEST_EXACTLY); -&test('Google', '$MAINTAINER', 'one_page', '+LS'.'AM +rep'.'lication', \$TEST_RANGE, 2,99); -&test('Google', '$MAINTAINER', 'multi', 'dir'.'ty ha'.'rr'.'y bimbo', \$TEST_GREATER_THAN, 101); -ENDTESTCASES - -use Carp (); -use WWW::Search(qw(generic_option strip_tags)); -require WWW::SearchResult; - - -sub undef_to_emptystring { -return defined($_[0]) ? $_[0] : ""; -} -# private -sub native_setup_search - { - my($self, $native_query, $native_options_ref) = @_; - $self->user_agent('user'); - $self->{_next_to_retrieve} = 0; - $self->{'_num_hits'} = 100; - if (!defined($self->{_options})) { - $self->{_options} = { - 'search_url' => 'http://www.google.com/search', - 'num' => $self->{'_num_hits'}, - }; - }; - my($options_ref) = $self->{_options}; - if (defined($native_options_ref)) { - # Copy in new options. - foreach (keys %$native_options_ref) { - $options_ref->{$_} = $native_options_ref->{$_}; - }; - }; - # Process the options. - my($options) = ''; - foreach (keys %$options_ref) { - # printf STDERR "option: $_ is " . $options_ref->{$_} . "\n"; - next if (generic_option($_)); - $options .= $_ . '=' . $options_ref->{$_} . '&'; - }; - $self->{_debug} = $options_ref->{'search_debug'}; - $self->{_debug} = 2 if ($options_ref->{'search_parse_debug'}); - $self->{_debug} = 0 if (!defined($self->{_debug})); - - # Finally figure out the url. - $self->{_base_url} = - $self->{_next_url} = - $self->{_options}{'search_url'} . - "?" . $options . - "q=" . $native_query; - } - -# private -sub begin_new_hit { - my($self) = shift; - my($old_hit) = shift; - my($old_raw) = shift; - if (defined($old_hit)) { - $old_hit->raw($old_raw) if (defined($old_raw)); - push(@{$self->{cache}}, $old_hit); - }; - return (new WWW::SearchResult, ''); - } -sub native_retrieve_some { - my ($self) = @_; - # fast exit if already done - return undef if (!defined($self->{_next_url})); - # get some - print STDERR "Fetching " . $self->{_next_url} . "\n" if ($self->{_debug}); - my($response) = $self->http_request('GET', $self->{_next_url}); - $self->{response} = $response; - if (!$response->is_success) { - return undef; - }; - - # parse the output - my($HEADER, $HITS, $TRAILER, $POST_NEXT) = (1..10); - my($hits_found) = 0; - my($state) = ($HEADER); - my($hit) = undef; - my($raw) = ''; - foreach ($self->split_lines($response->content())) { - next if m@^$@; # short circuit for blank lines - - if ($state == $HEADER && m/about <b>([\d,]+)<\/b>/) - { - my($n) = $1; - $self->approximate_result_count($n); - print STDERR "Found Total: $n\n" ; - $state = $HITS; - } - if ($state == $HITS && - m|<p><a href=([^\>]*)\>(.*?)</a\><br\>|i) { - my ($url, $title) = ($1,$2); - ($hit, $raw) = $self->begin_new_hit($hit, $raw); - print STDERR "**Found HIT0 Line** $url - $title\n" if ($self->{_debug}); - $raw .= $_; - $url =~ s/(>.*)//g; - $hit->add_url(strip_tags($url)); - $hits_found++; - $title = "No Title" if ($title =~ /^\s+/); - $hit->title(strip_tags($title)); - $state = $HITS; - } - elsif ($state == $HITS && - m|<a href=(.*)\>(.*?)</a><font size=-1><br><font color=green><.*?>|i) { - my ($url, $title) = ($1,$2); - ($hit, $raw) = $self->begin_new_hit($hit, $raw); - print STDERR "**Found HIT1 Line**\n" if ($self->{_debug}); - $raw .= $_; - $url =~ s/(>.*)//g; - $hit->add_url(strip_tags($url)); - $hits_found++; - $title = "No Title" if ($title =~ /^\s+/); - $hit->title(strip_tags($title)); - $state = $HITS; - } - elsif ($state == $HITS && - m@^<p><a href=/url\?sa=U&start=\d+&q=([^<]+)\&.*?>(.*)</a><font size=-1><br>(.*)@i || - m@^<p><a href=([^<]+)>(.*)</a>.*?<font size=-1><br>(.*)@i) - { - ($hit, $raw) = $self->begin_new_hit($hit, $raw); - print STDERR "**Found HIT2 Line**\n" if ($self->{_debug}); - my ($url, $title) = ($1,$2); - $mDesc = $3; - $url =~ s/\/url\?sa=\w&start=\d+&q=//g; - $url =~ s/&(.*)//g; - $url =~ s/(>.*)//g; - $raw .= $_; - $hit->add_url(strip_tags($url)); - $hits_found++; - $title = "No Title" if ($title =~ /^\s+/); - $hit->title(strip_tags($title)); - $mDesc =~ s/<.*?>//g; - $mDesc = $mDesc . '<br>' if not $mDesc =~ m@<br>@; - $hit->description($mDesc) if (defined($hit)); - $state = $HITS; - } - elsif ($state == $HITS && m@^(\.\.(.+))@i) - { - print STDERR "**Parsing Description Line**\n" if ($self->{_debug}); - $raw .= $_; - $sDesc = $1; - $sDesc ||= ''; - $sDesc =~ s/<.*?>//g; - $sDesc = $mDesc . $sDesc; - $hit->description($sDesc) if $sDesc =~ m@^\.@; - $sDesc = ''; - $state = $HITS; - } - elsif ($state == $HITS && m@<div class=nav>@i) - { - ($hit, $raw) = $self->begin_new_hit($hit, $raw); - print STDERR "**Found Last Line**\n" if ($self->{_debug}); - # end of hits - $state = $TRAILER; - } - elsif ($state == $TRAILER && - m|<a href=([^<]+)><IMG SRC=/nav_next.gif.*?>.*?|i) - { - my($relative_url) = $1; - print STDERR "**Fetching >>Next<< Page**\n" if ($self->{_debug}); - $self->{_next_url} = 'http://www.google.com' . $relative_url; - $state = $POST_NEXT; - } else { - }; - }; - if ($state != $POST_NEXT) { - # No "Next" Tag - $self->{_next_url} = undef; - if ($state == $HITS) { - $self->begin_new_hit($hit, $raw); - }; - $self->{_next_url} = undef; - }; - # ZZZzzzzZZZZzzzzzzZZZZZZzzz - $self->user_agent_delay if (defined($self->{_next_url})); - return $hits_found; - } -1; - diff --git a/blootbot/patches/Net_IRC_Connection_pm.patch b/blootbot/patches/Net_IRC_Connection_pm.patch deleted file mode 100644 index 400a1f8..0000000 --- a/blootbot/patches/Net_IRC_Connection_pm.patch +++ /dev/null @@ -1,32 +0,0 @@ ---- Connection.pm.orig Fri Nov 1 00:20:36 2002 -+++ Connection.pm Sat Nov 2 18:00:42 2002 -@@ -1300,14 +1300,13 @@ - # the line from the server. - sub parse_ctcp { - my ($self, $type, $from, $stuff, $line) = @_; -- - my ($one, $two); - my ($odd, @foo) = (&dequote($line)); - - while (($one, $two) = (splice @foo, 0, 2)) { - - ($one, $two) = ($two, $one) if $odd; -- -+ - my ($ctype) = $one =~ /^(\w+)\b/; - my $prefix = undef; - if ($type eq 'notice') { -@@ -1326,10 +1325,10 @@ - # -- #perl was here! -- - # fimmtiu: Words cannot describe my joy. Sil, you kick ass. - # fimmtiu: I was passing the wrong arg to Event::new() -- -- $one =~ s/^$ctype //i; # strip the CTCP type off the args -+ -+ # this is what it used to be in version 0.63 or so. - $self->handler(Net::IRC::Event->new( $handler, $from, $stuff, -- $handler, $one )); -+ $handler, (split /\s/, $one))); - } - - $self->handler(Net::IRC::Event->new($type, $from, $stuff, $type, $two)) diff --git a/blootbot/patches/WWW::Search.patch b/blootbot/patches/WWW::Search.patch deleted file mode 100644 index a276101..0000000 --- a/blootbot/patches/WWW::Search.patch +++ /dev/null @@ -1,444 +0,0 @@ ---- Google.pm.orig Wed May 24 16:55:47 2000 -+++ Google.pm Wed Jan 16 22:02:53 2002 -@@ -2,7 +2,7 @@ - # Google.pm - # by Jim Smyser - # Copyright (C) 1996-1999 by Jim Smyser & USC/ISI --# $Id$ -+# $Id$ - ########################################################## - - -@@ -30,8 +30,6 @@ - It handles making and interpreting Google searches. - F<http://www.google.com>. - --Googles returns 100 Hits per page. Custom Linux Only search capable. -- - This class exports no public interface; all interaction should - be done through L<WWW::Search> objects. - -@@ -70,33 +68,41 @@ - - This module adheres to the C<WWW::Search> test suite mechanism. - --=head1 BUGS -- --2.07 now parses for most of what Google produces, but not all. --Because Google does not produce universial formatting for all --results it produces, there are undoublty a few line formats yet --uncovered by the author. Different search terms creates various --differing format out puts for each line of results. Example, --searching for "visual basic" will create whacky url links, --whereas searching for "Visual C++" does not. It is a parsing --nitemare really! If you think you uncovered a BUG just remember --the above comments! -- --With the above said, this back-end will produce proper formated --results for 96+% of what it is asked to produce. Your milage --will vary. -- - =head1 AUTHOR - --This backend is maintained and supported by Jim Smyser. -+This backend is written and maintained/supported by Jim Smyser. - <jsmyser@bigfoot.com> - - =head1 BUGS - --2.09 seems now to parse all hits with the new format change so there really shouldn't be --any like there were with 2.08. -+Google is not an easy search engine to parse in that it is capable -+of altering it's output ever so slightly on different search terms. -+There may be new slight results output the author has not yet seen that -+will pop at any given time for certain searches. So, if you think you see -+a bug keep the above in mind and send me the search words you used so I -+may code for any new variations. -+ -+=head1 CHANGES -+ -+2.22 -+Fixed up changed format from google -+reformatted code -+ -+2.21 -+Minor code correction for empty returned titles -+ -+2.20 -+Forgot to add new next url regex in 2.19! -+ -+2.19 -+Regex work on some search results url's that has changed. Number found -+return should be right now. -+ -+2.17 -+Insert url as a title when no title is found. - --=head1 VERSION HISTORY -+2.13 -+New regexp to parse newly found results format with certain search terms. - - 2.10 - removed warning on absence of description; new test case -@@ -131,15 +137,18 @@ - WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF - MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. - -+ - =cut - #' -- -+ -+ - ##################################################################### -+ - require Exporter; - @EXPORT = qw(); - @EXPORT_OK = qw(); - @ISA = qw(WWW::Search Exporter); --$VERSION = '2.10'; -+$VERSION = '2.22'; - - $MAINTAINER = 'Jim Smyser <jsmyser@bigfoot.com>'; - $TEST_CASES = <<"ENDTESTCASES"; -@@ -148,160 +157,187 @@ - &test('Google', '$MAINTAINER', 'one_page', '+LS'.'AM +rep'.'lication', \$TEST_RANGE, 2,99); - &test('Google', '$MAINTAINER', 'multi', 'dir'.'ty ha'.'rr'.'y bimbo', \$TEST_GREATER_THAN, 101); - ENDTESTCASES -- -+ - use Carp (); --use WWW::Search(generic_option); -+use WWW::Search(qw(generic_option strip_tags)); - require WWW::SearchResult; -- -+ -+ -+sub undef_to_emptystring { -+return defined($_[0]) ? $_[0] : ""; -+} -+# private - sub native_setup_search { -- my($self, $native_query, $native_options_ref) = @_; -- $self->{_debug} = $native_options_ref->{'search_debug'}; -- $self->{_debug} = 2 if ($native_options_ref->{'search_parse_debug'}); -- $self->{_debug} = 0 if (!defined($self->{_debug})); -- $self->{agent_e_mail} = 'jsmyser@bigfoot.com'; -- $self->user_agent('user'); -- $self->{_next_to_retrieve} = 1; -- $self->{'_num_hits'} = 0; -- if (!defined($self->{_options})) { -- $self->{'search_base_url'} = 'http://www.google.com'; -- $self->{_options} = { -- 'search_url' => 'http://www.google.com/search', -- 'num' => '100', -- 'q' => $native_query, -- }; -- } -- my $options_ref = $self->{_options}; -- if (defined($native_options_ref)) -- { -- # Copy in new options. -- foreach (keys %$native_options_ref) -- { -- $options_ref->{$_} = $native_options_ref->{$_}; -- } # foreach -- } # if -- # Process the options. -- my($options) = ''; -- foreach (sort keys %$options_ref) -- { -- # printf STDERR "option: $_ is " . $options_ref->{$_} . "\n"; -- next if (generic_option($_)); -- $options .= $_ . '=' . $options_ref->{$_} . '&'; -- } -- chop $options; -- # Finally figure out the url. -- $self->{_next_url} = $self->{_options}{'search_url'} .'?'. $self->hash_to_cgi_string($self->{_options}); -- } # native_setup_search -- -+ my($self, $native_query, $native_options_ref) = @_; -+ $self->user_agent('user'); -+ $self->{_next_to_retrieve} = 0; -+ $self->{'_num_hits'} = 100; -+ -+ if (!defined $self->{_options}) { -+ $self->{_options} = { -+ 'search_url' => 'http://www.google.com/search', -+ 'num' => $self->{'_num_hits'}, -+ }; -+ } -+ -+ my($options_ref) = $self->{_options}; -+ -+ if (defined $native_options_ref) { -+ # Copy in new options. -+ foreach (keys %$native_options_ref) { -+ $options_ref->{$_} = $native_options_ref->{$_}; -+ } -+ } -+ -+ # Process the options. -+ my($options) = ''; -+ foreach (keys %$options_ref) { -+ # printf STDERR "option: $_ is " . $options_ref->{$_} . "\n"; -+ next if (generic_option($_)); -+ $options .= $_ . '=' . $options_ref->{$_} . '&'; -+ } -+ -+ $self->{_debug} = $options_ref->{'search_debug'}; -+ $self->{_debug} = 2 if ($options_ref->{'search_parse_debug'}); -+ $self->{_debug} = 0 if (!defined $self->{_debug}); -+ -+ # Finally figure out the url. -+ $self->{_base_url} = -+ $self->{_next_url} = -+ $self->{_options}{'search_url'} . -+ "?" . $options . -+ "q=" . $native_query; -+} -+ - # private --sub native_retrieve_some -- { -- my ($self) = @_; -- print STDERR "**Google::native_retrieve_some()**\n" if $self->{_debug}; -- # Fast exit if already done: -- return undef if (!defined($self->{_next_url})); -- -- # If this is not the first page of results, sleep so as to not -- # overload the server: -- $self->user_agent_delay if 1 < $self->{'_next_to_retrieve'}; -- -- # Get some if were not already scoring somewhere else: -- print STDERR "*Sending request (",$self->{_next_url},")\n" if $self->{_debug}; -- my($response) = $self->http_request('GET', $self->{_next_url}); -- $self->{response} = $response; -- if (!$response->is_success) -- { -- return undef; -- } -- $self->{'_next_url'} = undef; -- print STDERR "**Response\n" if $self->{_debug}; -- -- # parse the output -- my ($HEADER, $START, $HITS, $NEXT) = qw(HE HI ST NX); -- my $hits_found = 0; -- my $state = $HEADER; -- my $hit = (); -- foreach ($self->split_lines($response->content())) -- { -- next if m@^$@; # short circuit for blank lines -- print STDERR " $state ===$_=== " if 2 <= $self->{'_debug'}; -- if (m|<b>(\d+)</b></font> matches|i) { -- print STDERR "**Found Header Count**\n" if ($self->{_debug}); -- $self->approximate_result_count($1); -- $state = $START; -- # set-up attempting the tricky task of -- # fetching the very first HIT line -- } -- elsif ($state eq $START && m|Search took|i) -- { -- print STDERR "**Found Start Line**\n" if ($self->{_debug}); -- $state = $HITS; -- # Attempt to pull the very first hit line -- } -- if ($state eq $HITS) { -- print "\n**state == HITS**\n" if 2 <= $self->{_debug}; -- } -- if ($state eq $HITS && m@^<p><a href=([^<]+)>(.*)</a>$@i) -- { -- print "**Found HIT**\n" if 2 <= $self->{_debug}; -- my ($url, $title) = ($1,$2); -- if (defined($hit)) -- { -- push(@{$self->{cache}}, $hit); -- }; -- $hit = new WWW::SearchResult; -- # some queries *can* create internal junk in the url link -- # remove them! -- $url =~ s/\/url\?sa=U&start=\d+&q=//g; -- $hits_found++; -- $hit->add_url($url); -- $hit->title($title); -- $state = $HITS; -- } -- if ($state eq $HITS && m@^<font size=-1><br>(.*)@i) -- { -- print "**Found First Description**\n" if 2 <= $self->{_debug}; -- $mDesc = $1; -- if (not $mDesc =~ m@ @) -- { -- $mDesc =~ s/<.*?>//g; -- $mDesc = $mDesc . '<br>' if not $mDesc =~ m@<br>@; -- $hit->description($mDesc); -- $state = $HITS; -- } -- } -- elsif ($state eq $HITS && -- m@^(\.(.+))@i || -- m@^<br><font color=green>(.*)\s@i) { -- print "**Found Second Description**\n" if 2 <= $self->{_debug}; -- $sDesc = $1; -- $sDesc ||= ''; -- $sDesc =~ s/<.*?>//g; -- $sDesc = $mDesc . $sDesc; -- $hit->description($sDesc); -- $sDesc =''; -- $state = $HITS; -- } -- elsif ($state eq $HITS && -- m|<a href=([^<]+)><IMG SRC=/nav_next.gif.*?><br><.*?>.*?</A>|i) { -- my $nexturl = $self->{'_next_url'}; -- if (defined $nexturl) { -- print STDERR "**Fetching Next URL-> ", $nexturl, "\n" if 2 <= $self->{_debug}; -- } else { -- print STDERR "**Fetching Next URL-> UNDEF\n" if 2 <= $self->{_debug}; -- } -- -- my $iURL = $1; -- $self->{'_next_url'} = $self->{'search_base_url'} . $iURL; -- } -- else -- { -- print STDERR "**Nothing matched.**\n" if 2 <= $self->{_debug}; -- } -- } -- if (defined($hit)) -- { -- push(@{$self->{cache}}, $hit); -- } -- return $hits_found; -- } # native_retrieve_some --1; -+sub begin_new_hit { -+ my($self) = shift; -+ my($old_hit) = shift; -+ my($old_raw) = shift; -+ -+ if (defined $old_hit) { -+ $old_hit->raw($old_raw) if (defined $old_raw); -+ push(@{$self->{cache}}, $old_hit); -+ } -+ -+ return (new WWW::SearchResult, ''); -+} -+ -+sub native_retrieve_some { -+ my ($self) = @_; -+ # fast exit if already done -+ return undef if (!defined $self->{_next_url}); -+ -+ # get some -+ print STDERR "Fetching " . $self->{_next_url} . "\n" if ($self->{_debug}); -+ my($response) = $self->http_request('GET', $self->{_next_url}); -+ $self->{response} = $response; -+ -+ return undef if (!$response->is_success); -+ -+ # parse the output -+ my($HEADER, $HITS, $TRAILER, $POST_NEXT) = (1..10); -+ my($hits_found) = 0; -+ my($state) = ($HEADER); -+ my($hit) = undef; -+ my($raw) = ''; -+ -+ foreach ($self->split_lines($response->content())) { -+ next if m@^$@; # short circuit for blank lines -+ -+ if ($state == $HEADER && m/about <b>([\d,]+)<\/b>/) { -+ my($n) = $1; -+ $self->approximate_result_count($n); -+ print STDERR "Found Total: $n\n" if ($self->{_debug}); -+ $state = $HITS; -+ -+ } elsif ($state == $HITS && -+ m|<a href=(\S+)\>(.*?)</a><br><font size=-1><font color=\"#008000\"><.*?>|i -+ ) { -+ -+ my ($url, $title) = ($1,$2); -+ ($hit, $raw) = $self->begin_new_hit($hit, $raw); -+ print STDERR "**Found HIT1 Line**\n" if ($self->{_debug}); -+ $raw .= $_; -+ $url =~ s/(>.*)//g; -+ $hit->add_url(strip_tags($url)); -+ $hits_found++; -+ $title = "No Title" if ($title =~ /^\s+/); -+ $hit->title(strip_tags($title)); -+ $state = $HITS; -+ -+ } elsif ($state == $HITS && -+ m@^<p><a href=/url\?sa=U&start=\d+&q=([^<]+)\&.*?>(.*)</a><font size=-1><br>(.*)@i || -+ m@^<p><a href=(\S+)>(.*)</a>.*?<font size=-1>(.*)@i -+ ) { -+ print STDERR "**Found HIT2 Line**\n" if ($self->{_debug}); -+ -+ ($hit, $raw) = $self->begin_new_hit($hit, $raw); -+ -+ my ($url, $title) = ($1,$2); -+ $mDesc = $3; -+ -+ $url =~ s/\/url\?sa=\w&start=\d+&q=//g; -+ $url =~ s/\?lang=(\S+)$//g; -+ $url =~ s/&(.*)//g; -+ $url =~ s/(>.*)//g; -+ $url =~ s/\/$//g; # kill trailing slash. -+ -+ $raw .= $_; -+ $hit->add_url(strip_tags($url)); -+ $hits_found++; -+ -+ $title = "No Title" if ($title =~ /^\s+/); -+ $hit->title(strip_tags($title)); -+ -+ $mDesc =~ s/<.*?>//g; -+### $mDesc = $mDesc . '<br>' if not $mDesc =~ m@<br>@; -+ $hit->description($mDesc) if (defined $hit); -+ $state = $HITS; -+ -+# description parsing -+ } elsif ($state == $HITS && m@<b>(\.\.(.+))</b> @i -+ ) { -+ print STDERR "**Parsing Description Line**\n" if ($self->{_debug}); -+ $raw .= $_; -+ # uhm... -+ $sDesc = $1 || ""; -+ -+ $sDesc =~ s/<.*?>//g; -+ $mDesc ||= ""; -+ $sDesc = $mDesc . $sDesc; -+# $hit->description($sDesc) if $sDesc =~ m@^\.@; -+ $sDesc = ''; -+ $state = $HITS; -+ -+ } elsif ($state == $HITS && m@<div>@i -+ ) { -+ ($hit, $raw) = $self->begin_new_hit($hit, $raw); -+ print STDERR "**Found Last Line**\n" if ($self->{_debug}); -+ # end of hits -+ $state = $TRAILER; -+ -+ } elsif ($state == $TRAILER && -+ m|<a href=([^<]+)><img src=/nav_next.gif.*?>.*?|i -+ ) { -+ my($relative_url) = $1; -+ print STDERR "**Fetching >>Next<< Page**\n" if ($self->{_debug}); -+ $self->{_next_url} = 'http://www.google.com' . $relative_url; -+ $state = $POST_NEXT; -+ } -+ } -+ -+ if ($state != $POST_NEXT) { -+ # No "Next" Tag -+ $self->{_next_url} = undef; -+ $self->begin_new_hit($hit, $raw) if ($state == $HITS); -+ $self->{_next_url} = undef; -+ } -+ -+ # ZZZzzzzZZZZzzzzzzZZZZZZzzz -+ $self->user_agent_delay if (defined($self->{_next_url})); -+ return $hits_found; -+} -+ -+1; -+ diff --git a/blootbot/patches/WWW::Search.patch.old b/blootbot/patches/WWW::Search.patch.old deleted file mode 100644 index eec3ce3..0000000 --- a/blootbot/patches/WWW::Search.patch.old +++ /dev/null @@ -1,31 +0,0 @@ ---- WWW/Search/Google.pm.orig Wed May 24 16:55:47 2000 -+++ WWW/Search/Google.pm Wed May 24 16:56:19 2000 -@@ -240,7 +240,7 @@ - if ($state eq $HITS) { - print "\n**state == HITS**\n" if 2 <= $self->{_debug}; - } -- if ($state eq $HITS && m@^<p><a href=([^<]+)>(.*)</a>$@i) -+ if ($state eq $HITS && m@^<p><a href=([^<]+)>(.*)</a>@i) - { - print "**Found HIT**\n" if 2 <= $self->{_debug}; - my ($url, $title) = ($1,$2); -@@ -252,6 +252,7 @@ - # some queries *can* create internal junk in the url link - # remove them! - $url =~ s/\/url\?sa=U&start=\d+&q=//g; -+ $url =~ s/\&exp\=OneBoxNews\s//g; # new junk. - $hits_found++; - $hit->add_url($url); - $hit->title($title); -@@ -275,9 +276,8 @@ - print "**Found Second Description**\n" if 2 <= $self->{_debug}; - $sDesc = $1; - $sDesc ||= ''; -- $sDesc =~ s/<.*?>//g; -- $sDesc = $mDesc . $sDesc; -- $hit->description($sDesc); -+ $sDesc = $mDesc . $sDesc if (defined $mDesc); -+ $hit->description($sDesc) if (defined $hit and $sDesc ne ''); - $sDesc =''; - $state = $HITS; - } diff --git a/blootbot/scripts/backup_table-master.sh b/blootbot/scripts/backup_table-master.sh deleted file mode 100755 index a98bba7..0000000 --- a/blootbot/scripts/backup_table-master.sh +++ /dev/null @@ -1,20 +0,0 @@ -#!/bin/bash - -BACKUP_SRCDIR="/var/lib/mysql/" -BACKUP_TDIR="blootbot/" -BACKUP_FILE="/home/a/apt/public_html/tables.tar.bz2" - -pwd -echo "Copying... $BACKUP_SRCDIR/$BACKUP_TDIR" -cp -R $BACKUP_SRCDIR/$BACKUP_TDIR ~ - -if [ -d $BACKUP_TDIR ]; then - echo "Tarring... $BACKUP_FILE $BACKUP_TDIR" - tar -Icvf $BACKUP_FILE $BACKUP_TDIR - echo "Removing..." - rm -rf $BACKUP_TDIR -else - echo "ERROR: $BACKUP_TDIR doesn't exist." -fi - -exit 0; diff --git a/blootbot/scripts/backup_table-slave.pl b/blootbot/scripts/backup_table-slave.pl deleted file mode 100755 index bc7cbc7..0000000 --- a/blootbot/scripts/backup_table-slave.pl +++ /dev/null @@ -1,103 +0,0 @@ -#!/usr/bin/perl -w -# -# backup_table-slave.pl: Backup mysql tables -# Author: dms -# Version: v0.1b (20000223) -# Created: 20000210 -# - - -use strict; -use LWP; -use POSIX qw(strftime); - -my $backup_interval = 1; # every: 1,7,14,30. -my $backup_count = 7; -my $backup_url = "http://achilles.nyip.net/~apt/tables.tar.bz2"; -my $backup_file = "tables-##DATE.tar.bz2"; -my $backup_destdir = "/home/xk/public_html/"; -my $backup_indexfile = "tables-index.txt"; - -my %index; - -# Usage: &getURL($url); -sub getURL { - my ($url) = @_; - my ($ua,$res,$req); - - $ua = new LWP::UserAgent; - $ua->proxy('http', $ENV{'http_proxy'}) if (exists $ENV{'http_proxy'}); - $ua->proxy('http', $ENV{'HTTP_PROXY'}) if (exists $ENV{'HTTP_PROXY'}); - - $req = new HTTP::Request('GET',$url); - $res = $ua->request($req); - - # return NULL upon error. - if ($res->is_success) { - return $res->content; - } else { - print "error: failure.\n"; - exit 1; - } -} - -#... -if ( -f "$backup_destdir/$backup_indexfile") { - if (open(INDEX, "$backup_destdir/$backup_indexfile")) { - while (<INDEX>) { - chop; - - # days since 1970, file. - if (/^(\d+) (\S+)$/) { - $index{$1} = $2; - } - } - close INDEX; - } else { - print "WARNING: can't open $backup_indexfile.\n"; - } -} -my $now_days = (localtime)[7] + (((localtime)[5] - 70) * 365); -my $now_date = strftime("%Y%m%d", localtime); - -if (scalar keys %index) { - my $last_days = (sort {$b <=> $a} keys %index)[0]; - - if ($now_days - $last_days < $backup_interval) { - print "error: shouldn't run today.\n"; - goto recycle; - } -} - -$backup_file =~ s/##DATE/$now_date/; -print "backup_file => '$backup_file'.\n"; -if ( -f $backup_file) { - print "error: $backup_file already exists.\n"; - exit 1; -} - -my $file = &getURL($backup_url); -open(OUT,">$backup_destdir/$backup_file"); -print OUT $file; -close OUT; - -$index{$now_days} = $backup_file; -recycle:; -my @index = sort {$b <=> $a} keys %index; - -open(OUT,">$backup_destdir/$backup_indexfile"); -for(my $i=0; $i<scalar(@index); $i++) { - my $day = $index[$i]; - print "fe: day => '$day'.\n"; - - if ($backup_count - 1 >= $i) { - print "DEBUG: $day $index{$day}\n"; - print OUT "$day $index{$day}\n"; - } else { - print "Deleting $backup_destdir/$index{$day}\n"; - unlink "$backup_destdir/$index{$day}"; - } -} -close OUT; - -print "Done.\n"; diff --git a/blootbot/scripts/botchk.sh b/blootbot/scripts/botchk.sh deleted file mode 100755 index 7ed1b0d..0000000 --- a/blootbot/scripts/botchk.sh +++ /dev/null @@ -1,19 +0,0 @@ -#!/bin/sh - -BOTDIR=/home/apt/bot -BOTNICK=blootbot -PIDFILE=$BOTDIR/$BOTNICK.pid - -if [ -f $PIDFILE ]; then # exists. - PID=`cat $PIDFILE` - if [ -d /proc/$PID ]; then # already running. - exit 0 - fi - - # blootbot removes the pid file. - echo "stale pid file; removing." -# rm -f $PIDFILE -fi - -cd $BOTDIR -./blootbot diff --git a/blootbot/scripts/dbm2mysql.pl b/blootbot/scripts/dbm2mysql.pl deleted file mode 100755 index 922bbb5..0000000 --- a/blootbot/scripts/dbm2mysql.pl +++ /dev/null @@ -1,58 +0,0 @@ -#!/usr/bin/perl -# by the xk. -### - -require "src/core.pl"; -require "src/logger.pl"; -require "src/modules.pl"; - -require "src/Misc.pl"; -require "src/Files.pl"; -&loadDBModules(); -require "src/dbi.pl"; -package main; - -# todo: main() - -if (!scalar @ARGV) { - print "Usage: dbm2mysql <whatever dbm>\n"; - print "Example: dbm2mysql.pl apt\n"; - print "NOTE: suffix '-is' and '-extra' are used.\n"; - exit 0; -} - -my $dbfile = shift; -my $key; -my %db; - -# open dbm. -if (!dbmopen(%db, $dbfile, 0666)) { - &ERROR("Failed open to dbm file ($dbfile)."); - exit 1; -} -&status("::: opening dbm file: $dbfile"); - -# open all the data... -&loadConfig("files/blootbot.config"); -$dbname = $param{'DBName'}; -my $dbh_mysql = sqlOpenDB($param{'DBName'}, - $param{'DBType'}, $param{'SQLUser'}, $param{'SQLPass'}); -print "DEBUG: scalar db == '". scalar(keys %db) ."'.\n"; - -my $factoid; -my $ndef = 1; -my $i = 1; -foreach $factoid (keys %db) { - &sqlReplace("factoids", { - factoid_key => $_, - factoid_value => $db{$_}, - } ); - - $i++; - print "i=$i... " if ($i % 100 == 0); - print "ndef=$ndef... " if ($ndef % 1000 == 0); -} - -print "Done.\n"; -&closeDB(); -dbmclose(%db); diff --git a/blootbot/scripts/dbm2txt.pl b/blootbot/scripts/dbm2txt.pl deleted file mode 100755 index 259e6ce..0000000 --- a/blootbot/scripts/dbm2txt.pl +++ /dev/null @@ -1,24 +0,0 @@ -#!/usr/bin/perl -w - -use strict; -use DB_File; -if (!scalar @ARGV) { - print "Usage: dbm2txt <whatever dbm>\n"; - print "Example: dbm2txt.pl factoids\n"; - exit 0; -} - -my $dbfile = shift; -my %db; -if (0) { - require "src/Factoids/db_dbm.pl"; - openDB(); -} - -dbmopen(%db, $dbfile, 0644) or die "error: cannot open db. $dbfile\n"; -my ($key, $val); -while (($key, $val) = each %db) { - chomp $val; - print "$key => $val\n"; -} -dbmclose %db; diff --git a/blootbot/scripts/findparam.pl b/blootbot/scripts/findparam.pl deleted file mode 100644 index 900920f..0000000 --- a/blootbot/scripts/findparam.pl +++ /dev/null @@ -1,72 +0,0 @@ -#!/usr/bin/perl -w - -use strict; - -my(%param, %conf, %both); - -foreach (`find -name "*.pl"`) { - chop; - my $file = $_; - my $debug = 0; - - open(IN, $file); - while (<IN>) { - chop; - - if (/IsParam\(['"](\S+?)['"]\)/) { - print "File: $file: IsParam: $1\n" if $debug; - $param{$1}++; - next; - } - - if (/IsChanConfOrWarn\(['"](\S+?)['"]\)/) { - print "File: $file: IsChanConfOrWarn: $1\n" if $debug; - $both{$1}++; - next; - } - - if (/getChanConfDefault\(['"](\S+?)['"]/) { - print "File: $file: gCCD: $1\n" if $debug; - $both{$1}++; - next; - } - - if (/getChanConf\(['"](\S+?)['"]/) { - print "File: $file: gCC: $1\n" if $debug; - $conf{$1}++; - next; - } - - if (/IsChanConf\(['"](\S+?)['"]\)/) { - print "File: $file: ICC: $1\n" if $debug; - $conf{$1}++; - next; - } - - # command hooks => IsChanConfOrWarn => both. - # note: this does not support multiple lines. - if (/\'Identifier\'[\s\t]=>[\s\t]+\'(\S+?)\'/) { - print "File: $file: command hook: $1\n" if $debug; - $both{$1}++; - next; - } - } - close IN; -} - -print "Conf AND/OR Params:\n"; -foreach (sort keys %both) { - print " $_\n"; -} -print "\n"; - -print "Params:\n"; -foreach (sort keys %param) { - print " $_\n"; -} -print "\n"; - -print "Conf:\n"; -foreach (sort keys %conf) { - print " $_\n"; -} diff --git a/blootbot/scripts/fixbadchars.pl b/blootbot/scripts/fixbadchars.pl deleted file mode 100644 index 8f9d072..0000000 --- a/blootbot/scripts/fixbadchars.pl +++ /dev/null @@ -1,67 +0,0 @@ -#!/usr/bin/perl -w - -use DBI; - -my $dsn = "DBI:mysql:blootbot:localhost"; -my $dbh = DBI->connect($dsn, "USERNAME", "PASSWORD"); - -my @factkey; -my %factval; -my $query; -my $regex = '\\\\([\_\%])'; - -$query = "SELECT factoid_key,factoid_value from factoids"; -my $sth = $dbh->prepare($query); -$sth->execute; -while (my @row = $sth->fetchrow_array) { - if ($row[0] =~ /$regex/) { - push(@factkey,$row[0]); - } else { - $factval{$row[0]} = $row[1] if ($row[1] =~ /$regex/); - } -} -$sth->finish; - -print "scalar factkey => '". scalar(@factkey) ."'\n"; -foreach (@factkey) { - print "factkey => '$_'.\n"; - my $new = $_; - $new =~ s/$regex/$1/g; - - next if ($new eq $_); - - $query = "SELECT factoid_key FROM factoids where factoid_key=". - $dbh->quote($new); - my $sth = $dbh->prepare($query); - $sth->execute; - if (scalar $sth->fetchrow_array) { # exist. - print "please remove $new or $_.\n"; - } else { # ! exist. - $sth->finish; - - $query = "UPDATE factoids SET factoid_key=".$dbh->quote($new). - " WHERE factoid_key=".$dbh->quote($_); - my $sth = $dbh->prepare($query); - $sth->execute; - $sth->finish; - } -} - -print "scalar factval => '". scalar(keys %factval) ."\n"; -foreach (keys %factval) { - print "factval => '$_'.\n"; - my $fact = $_; - my $old = $factval{$_}; - my $new = $old; - $new =~ s/$regex/$1/g; - - next if ($new eq $old); - - $query = "UPDATE factoids SET factoid_value=".$dbh->quote($new). - " WHERE factoid_key=".$dbh->quote($fact); - my $sth = $dbh->prepare($query); - $sth->execute; - $sth->finish; -} - -$dbh->disconnect(); diff --git a/blootbot/scripts/insertDB.pl b/blootbot/scripts/insertDB.pl deleted file mode 100644 index d11cd09..0000000 --- a/blootbot/scripts/insertDB.pl +++ /dev/null @@ -1,36 +0,0 @@ -#!/usr/bin/perl -w - -$| = 1; - -use strict; - -require "src/core.pl"; -require "src/logger.pl"; -require "src/modules.pl"; -require "src/Factoids/DBCommon.pl"; - -&loadConfig($bot_config_dir."/blootbot.config"); -&loadDBModules(); - -unless (@_) { - print "hrm.. usage\n"; - exit 0; -} - -foreach (@_) { - next unless ( -f $_); - - open(IN, $_) or die "error: cannot open $_\n"; - print "Opened $_ for input...\n"; - - print "inserting... "; - while (<IN>) { - next unless (/^(.*?) => (.*)$/); - - ### TODO: check if it already exists. if so, don't add. - &setFactInfo($1, "factoid_value", $2); - print ":: $1 "; - } - - close IN; -} diff --git a/blootbot/scripts/irclog2html.pl b/blootbot/scripts/irclog2html.pl deleted file mode 100755 index 9cef018..0000000 --- a/blootbot/scripts/irclog2html.pl +++ /dev/null @@ -1,325 +0,0 @@ -#!/usr/bin/perl -w - -# irclog2html.pl Version 1.5 - 11th May 2000 -# Copyright (C) 2000, Jeffrey W. Waugh - -# Author: -# Jeff Waugh <jdub@aphid.net> - -# Contributors: -# Rick Welykochy <rick@praxis.com.au> -# Alexander Else <aelse@uu.net> - -# Released under the terms of the GNU GPL -# http://www.gnu.org/copyleft/gpl.html - -# Modified by Tim Riker <Tim@Rikers.org> -# to work with infobot logs -# then modified again for blootbot - -# Usage: irclog2html <date> < logfile - -# irclog2html will write out a colourised irc log, appending a .html -# extension to the output file. - - -#################################################################################### -# Perl Configuration - -use strict; -$^W = 1; #RW# turn on warnings -use POSIX qw(strftime); - - -#################################################################################### -# Preferences - -# Comment out the "table" assignment to use the plain version - -#my $STYLE = "tt"; -#my $STYLE = "simplett"; -#my $STYLE = "table"; -my $STYLE = "simpletable"; - -my $colour_left = "#000099"; # nick leaving channel -my $colour_joined = "#009900"; # nick joining channel -my $colour_server = "#009900"; # server message (***) -my $colour_nickchange = "#009900"; # nick change -my $colour_action = "#CC00CC"; # nick action (/me waves) - -my %prefs_colour_nick = ( - "jdub" => "#993333", - "cantanker" => "#006600", - "chuckd" => "#339999", -); - - -#################################################################################### -# Utility Functions - -sub header { - my ($channel, $date) = @_; - my $return = ''; - - $return .= qq{<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"> -<html> -<head> - <title>irclog2html for $channel on $date - - - - - -

irclog2html for $channel on $date

-}; - - if ($STYLE =~ /table/) { - $return .= "\n"; - } - return $return; -} - -sub footer { - my $return = ''; - if ($STYLE =~ /table/) { - $return .= "
\n"; - } - - $return .= qq{ -
Generated by irclog2html.pl by -Jeff Waugh - find it at -freshmeat.net! -Modified by Tim Riker to work with -blootbot logs, split per channel, etc. - -}; - return $return; -} - -my $lastdate = ''; - -sub add_footers { - my $filename; - - return if not $lastdate; - - my @files=`ls $lastdate.html */$lastdate.html`; - foreach $filename (@files) { - chomp $filename; - if (!open(OUTPUT, ">>$filename")) { - print "Cannot open $filename for writing!\n\n"; - return; - } - print OUTPUT footer(); - close OUTPUT; - } -} - -sub output_line { - my ($date, $time, $channel, $lineout) = @_; - - add_footers() if $lastdate ne $date; - - $lastdate = $date; - my $filename = ""; - $filename .= "$channel/" if $channel; - $filename .= "$date.html"; - - mkdir($channel,oct('755')) if ($channel && ! -d $channel); - if (!open(OUTPUT, ">>$filename")) { - #print "Cannot open $filename for writing!\n\n"; - return; - } - # Begin output # - print OUTPUT header($channel, $date) if -z $filename; - - print OUTPUT $lineout; - - close OUTPUT; -} - -sub output_timenicktext { - my ($date, $time, $channel, $nick, $text, $htmlcolour) = @_; - my $lineout = ''; - - if ($STYLE eq "table") { - $lineout .= ""; - $lineout .= "$time" if $time; - $lineout .= "$nick"; - $lineout .= "$text<\/font>\n"; - } - elsif ($STYLE eq "simpletable") { - $lineout .= ""; - $lineout .= "$time" if $time; - $lineout .= "$nick"; - $lineout .= "$text\n"; - } - elsif ($STYLE eq "simplett") { - $lineout .= "$time " if $time; - $lineout .= "<\;$nick>\; $text
\n"; - } - else { - $lineout .= "$time " if $time; - $lineout .= "<\;$nick>\; $text<\/font>
\n"; - } - output_line($date, $time, $channel, $lineout); -} - -sub output_timeservermsg { - my ($date, $time, $channel, $line) = @_; - my $lineout = ''; - - if ($STYLE =~ /table/) { - $lineout .= ""; - $lineout .= "$time" if $time; - $lineout .= "$line\n"; - } - else { - $lineout .= "$time " if $time; - $lineout .= "$line
\n"; - } - output_line($date, $time, $channel, $lineout); -} - -sub html_rgb -{ - my ($i,$ncolours) = @_; - $ncolours = 1 if $ncolours == 0; - - my $rgbmax = 125; # tune these two for the outmost ranges of colour depth - my $rgbmin = 240; - - my $a = 0.95; # tune these for the starting and ending concentrations of R,G,B - my $c = 0.5; - - my $rgb = [ [$a,$c,$c], [$c,$a,$c], [$c,$c,$a], [$a,$a,$c], [$a,$c,$a], [$c,$a,$a] ]; - my $n = $i % @$rgb; - my $m = $rgbmin + ($rgbmax - $rgbmin) * ($ncolours - $i) / $ncolours; - - my $r = $rgb->[$n][0] * $m; - my $g = $rgb->[$n][1] * $m; - my $b = $rgb->[$n][2] * $m; - sprintf("#%02x%02x%02x",$r,$g,$b); -} - -#################################################################################### -# Main - -sub main { - my ($date) = @_; - my $files; - - my $line; - my $time; - my $lastdate = ""; - my $nick; - my $channel; - my $text; - - my $htmlcolour; - my $nickcount = 0; - my $NICKMAX = 30; - - my %colour_nick = %prefs_colour_nick; - - while ($line = ) { - - chomp $line; - - if (!$line eq "") { - # parse out the time - if ($line =~ s/^([0-9:\.]*) (.*)$/$2/) { - $time = $1; - } else { - $time = ''; - } - $channel = ''; - - # Replace ampersands, pointies, control characters # - $line =~ s/&/&\;/g; - $line =~ s//>\;/g; - $line =~ s/\e\[[0-1]*m//g; - $line =~ s/[\x00-\x1f]+//g; - - # Replace possible URLs with links # - $line =~ s/((http|https|ftp|gopher|news):\/\/\S*)/$1<\/a>/g; - - # Colourise the comments - if ($line =~ /^<\;[^\/]*?\/\#.*?>\; .*$/) { - # Split $nick, $channel and $line - $nick = $line; - $nick =~ s/^<\;([^\/]*?)\/\#.*?>\; .*$/$1/; - $channel = $line; - $channel =~ s/^<\;[^\/]*?\/(\#.*?)>\; .*$/$1/; - - # $nick =~ tr/[A-Z]/[a-z]/; - # <======= move this into another function when getting nick colour - - $text = $line; - $text =~ s/^<\;.*?>\; (.*)$/$1/; - $text =~ s/^ .*/<\;PROTECTED>\;/g; - $text =~ s/ / \; \;/g; - - $htmlcolour = $colour_nick{$nick}; - if (!defined($htmlcolour)) { - # new nick - $nickcount++; - - # if we've exceeded our estimate of the number of nicks, double it - $NICKMAX *= 2 if $nickcount >= $NICKMAX; - - $htmlcolour = $colour_nick{$nick} = html_rgb($nickcount, $NICKMAX); - } - output_timenicktext($date, $time, $channel, $nick, $text, $htmlcolour); - } elsif ($line =~ /^>\;>\;>\; /) { - $line =~ s/^>\;>\;>\; /\*\*\* /; - - # Process changed nick results, and remember colours accordingly # - if ($line =~ /\*\*\* (.*?) materializes into (.*)/) { - my $nick_old = $1; - my $nick_new = $2; - - #$nick_old = $line; - #$nick_old =~ s/\*\*\* (.*?) materializes into .*/$1/; - #$nick_new = $line; - #$nick_new =~ s/\*\*\* (.*?) materializes into (.*)/$2/; - - $colour_nick{$nick_new} = $colour_nick{$nick_old}; - $colour_nick{$nick_old} = undef; - - $line =~ s/(\*\*\* .*)/$1<\/font>/ - } elsif ($line =~ /\*\*\* (join|mode|topic)\/(.*?) .*/) { - $channel = lc $2; - $line =~ s/(\*\*\* .*)/$1<\/font>/; - } elsif ($line =~ /\*\*\* (part|kick|banned)\/(.*?) .*/) { - $channel = lc $2; - $line =~ s/(\*\*\* .*)/$1<\/font>/; - } elsif ($line =~ /\*\*\* .* has signed off IRC .*/) { - # Colourise joined/left/server messages # - $line =~ s/(\*\*\* .*)/$1<\/font>/; - } elsif ($line =~ /\*\*\* /) { - $line =~ s/(\*\*\* .*)$/$1<\/font>/; - } elsif ($line =~ /^\* .*$/) { - # Colourise the /me's # - $line =~ s/^(\*.*)$/$1<\/font>/; - } - - output_timeservermsg($date, $time, $channel, $line); - } - } - } - - add_footers(); - - return 0; -} - -if (!scalar @ARGV) { - print "Usage: irclog2html.pl < logfile\n"; - print "Example: bzcat log/blootbot.log-20021104.bz2 | irclog2html.pl 20021104\n"; - exit 0; -} -my $date = shift; -exit &main($date); -# vim: ts=2 diff --git a/blootbot/scripts/makepasswd b/blootbot/scripts/makepasswd deleted file mode 100755 index b76617c..0000000 --- a/blootbot/scripts/makepasswd +++ /dev/null @@ -1,20 +0,0 @@ -#!/usr/bin/perl - -$| = 1; - -print "plaintext> "; -while (<>) { - chomp; - $result = &mkpasswd($_); - print "\t$result\n"; - print "plaintext> "; -} - -sub mkpasswd { - my $what = $_[0]; - my $salt = chr(65+rand(27)).chr(65+rand(27)); - $salt =~ s/\W/x/g; - - return crypt($what, $salt); -} - diff --git a/blootbot/scripts/mysql2txt.pl b/blootbot/scripts/mysql2txt.pl deleted file mode 100755 index 53f3b77..0000000 --- a/blootbot/scripts/mysql2txt.pl +++ /dev/null @@ -1,47 +0,0 @@ -#!/usr/bin/perl -# mysql -> txt. -# written by the xk. -### - -require "src/core.pl"; -require "src/logger.pl"; -require "src/modules.pl"; -require "src/Misc.pl"; -require "src/Files.pl"; -$bot_src_dir = "./src/"; - -my $dbname = shift; -if (!defined $dbname) { - print "Usage: $0 \n"; - print "Example: $0 factoids\n"; - exit 0; -} - -# open the db. -&loadConfig("files/blootbot.config"); -&loadDBModules(); - -&openDB($param{'DBName'}, $param{'SQLUser'}, $param{'SQLPass'}); - -# retrieve a list of db's from the server. -my %db; -foreach ($dbh->func('_ListTables')) { - $db{$_} = 1; -} - -# factoid db. -if (!exists $db{$dbname}) { - print "error: $dbname does not exist as a table.\n"; - exit 1; -} - -my $query = "SELECT factoid_key,factoid_value from $param{'DBName'}.$dbname"; -my $sth = $dbh->prepare($query); -$sth->execute; -while (my @row = $sth->fetchrow_array) { - print "$row[0] => $row[1]\n"; -} -$sth->finish; - -print "Done.\n"; -&closeDB(); diff --git a/blootbot/scripts/oreilly_dumpvar.pl b/blootbot/scripts/oreilly_dumpvar.pl deleted file mode 100644 index 3efe8b6..0000000 --- a/blootbot/scripts/oreilly_dumpvar.pl +++ /dev/null @@ -1,27 +0,0 @@ -package DUMPVAR; -sub dumpvar { - ($packageName) = @_; - $rPackage = \%{"${packageName}::"}; # Get a reference to the appropriate symbol table hash. - $, = " " ; - while (($varName, $globValue) = each %$rPackage) { - print "$varName ============================= \n"; - *var = $globValue; - if (defined ($var)) { - print "\t \$$varName $var \n"; - } - if (defined (@var)) { - print "\t \@$varName @var \n"; - } - if (defined (%var)) { - print "\t \%$varName ",%var," \n"; - } - } -} - - -package Test; -$x = 10; -@y = (1,3,4); -%z = (1,2,3,4, 5, 6, \@y); -$z = 300; -DUMPVAR::dumpvar("Test"); diff --git a/blootbot/scripts/oreilly_prettyp.pl b/blootbot/scripts/oreilly_prettyp.pl deleted file mode 100644 index db58d78..0000000 --- a/blootbot/scripts/oreilly_prettyp.pl +++ /dev/null @@ -1,87 +0,0 @@ -@sample = (11.233,{3 => 4, "hello" => [6,7]}); -pretty_print(@sample); - -$level = -1; # Level of indentation - -sub pretty_print { - my $var; - foreach $var (@_) { - if (ref ($var)) { - print_ref($var); - } else { - print_scalar($var); - } - } -} - -sub print_scalar { - ++$level; - print_indented ($_[0]); - --$level; -} - -sub print_ref { - my $r = $_[0]; - if (exists ($already_seen{$r})) { - print_indented ("$r (Seen earlier)"); - return; - } else { - $already_seen{$r}=1; - } - my $ref_type = ref($r); - if ($ref_type eq "ARRAY") { - print_array($r); - } elsif ($ref_type eq "SCALAR") { - print "Ref -> $r"; - print_scalar($$r); - } elsif ($ref_type eq "HASH") { - print_hash($r); - } elsif ($ref_type eq "REF") { - ++$level; - print_indented("Ref -> ($r)"); - print_ref($$r); - --$level; - } else { - print_indented ("$ref_type (not supported)"); - } -} - -sub print_array { - my ($r_array) = @_; - ++$level; - print_indented ("[ # $r_array"); - foreach $var (@$r_array) { - if (ref ($var)) { - print_ref($var); - } else { - print_scalar($var); - } - } - print_indented ("]"); - --$level; -} - -sub print_hash { - my($r_hash) = @_; - my($key, $val); - ++$level; - print_indented ("{ # $r_hash"); - while (($key, $val) = each %$r_hash) { - $val = ($val ? $val : '""'); - ++$level; - if (ref ($val)) { - print_indented ("$key => "); - print_ref($val); - } else { - print_indented ("$key => $val"); - } - --$level; - } - print_indented ("}"); - --$level; -} - -sub print_indented { - $spaces = ": " x $level; - print "${spaces}$_[0]\n"; -} diff --git a/blootbot/scripts/output_stats.sh b/blootbot/scripts/output_stats.sh deleted file mode 100644 index 0b877bd..0000000 --- a/blootbot/scripts/output_stats.sh +++ /dev/null @@ -1,7 +0,0 @@ -#!/bin/sh -echo -n "DEBUG: "; grep DEBUG `find blootbot src -type f`| wc -l -echo -n "WARN: "; grep WARN `find blootbot src -type f` | wc -l -echo -n "FIXME: "; grep FIXME `find blootbot src -type f` | wc -l -echo -n "status: "; grep status `find blootbot src -type f` | wc -l -echo -n "ERROR: "; grep ERROR `find blootbot src -type f` | wc -l -echo -n "TODO: "; grep TODO `find blootbot src -type f` | wc -l diff --git a/blootbot/scripts/parse_warn.pl b/blootbot/scripts/parse_warn.pl deleted file mode 100755 index 53a224c..0000000 --- a/blootbot/scripts/parse_warn.pl +++ /dev/null @@ -1,91 +0,0 @@ -#!/usr/bin/perl -w - -# leading and trailing context lines. -my $contextspread = 2; - -use strict; - -$| = 1; - -if (!scalar @ARGV) { - print "Usage: parse_warn.pl \n"; - print "Example: parse_warn.pl log/*\n"; - exit 0; -} - -my %done; -my $file; - -foreach $file (@ARGV) { - if (! -f $file) { - print "warning: $file does not exist.\n"; - next; - } - my $str = ' at .* line '; - - print "Opening $file... "; - if ($file =~ /bz2$/) { # bz2 - open(FILE, "bzcat $file | egrep '$str' |"); - } elsif ($file =~ /gz$/) { # gz - open(FILE, "zegrep '$str' $file |"); - } else { # raw - open(FILE, "egrep '$str' $file |"); - } - - print "Parsing... "; - while () { - if (/ at (\S+) line (\d+)/) { - my ($file,$lineno) = ($1,$2+1); - $done{$file}{$lineno}++; - } - } - close FILE; - - print "Done.\n"; -} - -foreach $file (keys %done) { - my $count = scalar(keys %{$done{$file}}); - print "warn $file: $count unique warnings.\n"; - - if (! -f $file) { - print "=> error: does not exist.\n\n"; - next; - } - - if (open(IN,$file)) { - my @lines = ; - close IN; - - my $total = scalar @lines; - my $spread = 0; - my $done = 0; - for(my $i=0; $i<=$total; $i++) { - next unless (exists $done{$file}{$i+$contextspread} or $spread); - - if (exists $done{$file}{$i+$contextspread}) { - print "@@ $i @@\n" unless ($spread); - # max lines between offending lines should be 2*context-1. - # coincidence that it is! - $spread = 2*$contextspread; - } else { - $spread--; - } - - if (exists $done{$file}{$i}) { - print "*** "; - } else { - print "--- "; - } - - if ($i >= $total) { - print "EOF\n"; - } else { - print $lines[$i]; - } - } - print "\n"; - } else { - print "=> error: could not open file.\n"; - } -} diff --git a/blootbot/scripts/showvars.pl b/blootbot/scripts/showvars.pl deleted file mode 100644 index 22c55ac..0000000 --- a/blootbot/scripts/showvars.pl +++ /dev/null @@ -1,110 +0,0 @@ -@test = ("test"); - -sub dumpvar { - ($packageName) = @_; - $rPackage = \%{"${packageName}::"}; # Get a reference to the appropriate symbol table hash. - $, = " " ; - while (($varName, $globValue) = each %$rPackage) { - last if ($varName eq "main::"); - print "$varName ============================= \n"; - *var = $globValue; - if (defined ($var)) { - print "\t \$$varName = '$var' \n"; - } - if (defined (@var)) { - pretty_print(@var); -### print "\t \@$varName @var \n"; - } - if (defined (%var)) { - pretty_print(%var); -### print "\t \%$varName ",%var," \n"; - } - } -} - -dumpvar("main"); - -$level = -1; # Level of indentation - -sub pretty_print { - my $var; - foreach $var (@_) { - if (ref ($var)) { - print_ref($var); - } else { - print_scalar($var); - } - } -} - -sub print_scalar { - ++$level; - print_indented ($_[0]); - --$level; -} - -sub print_ref { - my $r = $_[0]; - if (exists ($already_seen{$r})) { - print_indented ("$r (Seen earlier)"); - return; - } else { - $already_seen{$r}=1; - } - my $ref_type = ref($r); - if ($ref_type eq "ARRAY") { - print_array($r); - } elsif ($ref_type eq "SCALAR") { - print "Ref -> $r"; - print_scalar($$r); - } elsif ($ref_type eq "HASH") { - print_hash($r); - } elsif ($ref_type eq "REF") { - ++$level; - print_indented("Ref -> ($r)"); - print_ref($$r); - --$level; - } else { - print_indented ("$ref_type (not supported)"); - } -} - -sub print_array { - my ($r_array) = @_; - ++$level; - print_indented ("[ # $r_array"); - foreach $var (@$r_array) { - if (ref ($var)) { - print_ref($var); - } else { - print_scalar($var); - } - } - print_indented ("]"); - --$level; -} - -sub print_hash { - my($r_hash) = @_; - my($key, $val); - ++$level; - print_indented ("{ # $r_hash"); - while (($key, $val) = each %$r_hash) { - $val = ($val ? $val : '""'); - ++$level; - if (ref ($val)) { - print_indented ("$key => "); - print_ref($val); - } else { - print_indented ("$key => $val"); - } - --$level; - } - print_indented ("}"); - --$level; -} - -sub print_indented { - $spaces = ": " x $level; - print "${spaces}$_[0]\n"; -} diff --git a/blootbot/scripts/symname.pl b/blootbot/scripts/symname.pl deleted file mode 100755 index dfa71c7..0000000 --- a/blootbot/scripts/symname.pl +++ /dev/null @@ -1,104 +0,0 @@ -#!/usr/bin/perl -w - -# hrm... -#use strict; - -my @test; -my @test1; -my %test; - -$test{'hash0r'} = 2; -$test{'hegdfgsd'} = 'GSDFSDfsd'; - -push(@test1,"Aeh."); -push(@test1,"Beh."); -push(@test1,"Ceh."); -push(@test1,"Deh."); - -push(@test,"heh."); -push(@test,\%test); -#push(@test,\%ENV); -push(@test,\@test1); - -print "=============start=================\n"; -#&DumpArray(0, '@test', \@test); -&DumpPackage(0, 'main::', \%main::); - -# SCALAR ARRAY HASH CODE REF GLOB LVALUE -sub DumpArray { - my ($pad, $symname, $arrayref) = @_; - my $padding = " " x $pad; - my $scalar = 0; - my $size = 0; - - print "$padding$symname\n"; - foreach (@{$arrayref}) { - my $ref = ref $_; - if ($ref eq 'ARRAY') { - $size += &DumpArray($pad+1, "@" . $_, $_); - } elsif ($ref eq 'HASH') { - $size += &DumpHash($pad+1, "%" . $_, $_); - } else { - print "$padding $_ $ref\n"; - $scalar++; - $size += length($_); - } - } - print $padding."scalars $scalar, size $size\n"; - return $size; -} - -sub DumpHash{ - my ($pad, $symname, $hashref) = @_; - my $padding = " " x $pad; - my $scalar = 0; - my $size = 0; - - my %sym = %{$hashref}; - my @list = sort keys %sym; - print "$padding$symname\n"; - - foreach (@list) { - my $ref = ref %{$symname}; #FIXME - $size += length($_); - if ($ref eq 'ARRAY') { - $size += &DumpArray($pad+1, "@" . $_, $_); - } elsif ($ref eq 'HASH') { - $size += &DumpHash($pad+1, "%" . $_, $_); - } else { - print "$padding $_=$sym{$_} $ref\n"; - $scalar++; - $size += length($sym{$_}); - } - } - print $padding."scalars $scalar, size $size\n"; - return $size; -} - -sub DumpPackage { - my ($pad, $packname, $package) = @_; - my $padding = " " x $pad; - my $scalar = 0; - my $size = 0; - - print $padding . "\%$packname\n"; - my $symname; - foreach $symname (sort keys %$package) { - local *sym = $$package{$symname}; - if (defined $sym) { - print "$padding \$$symname='$sym'\n"; - $scalar++; - $size += length($sym); - } elsif (defined @sym) { - $size += &DumpArray($pad+1, $symname, \@sym); - } elsif (defined %sym) { - $size += &DumpHash($pad+1, $symname, \%sym); - } elsif (($symname =~ /::/) and ($symname ne 'main::')) { - $size += &DumpPackage($pad+1, \%sym, $symname); - } else { - print("ERROR $symname" . ref $symname . "\n"); - } - } - print $padding."scalars $scalar, size $size\n"; - return $size; -} diff --git a/blootbot/scripts/txt2mysql.pl b/blootbot/scripts/txt2mysql.pl deleted file mode 100755 index 47a70b7..0000000 --- a/blootbot/scripts/txt2mysql.pl +++ /dev/null @@ -1,57 +0,0 @@ -#!/usr/bin/perl -# by the xk. -# - -require "src/core.pl"; -require "src/logger.pl"; -require "src/modules.pl"; -require "src/Files.pl"; -require "src/Misc.pl"; -require "src/Factoids/DBCommon.pl"; - -if (!scalar @ARGV) { - print "Usage: txt2mysql.pl \n"; - exit 0; -} - -# open the txtfile. -my $txtfile = shift; -open(IN,$txtfile) or die "error: cannot open txtfile '$txtfile'.\n"; - -# read the bot config file. -&loadConfig("files/blootbot.config"); -&loadDBModules(); -&openDB($param{'DBName'}, $param{'SQLUser'}, $param{'SQLPass'}); - -### now pipe all the data to the mysql server... -my $i = 1; -print "converting factoid db to mysql...\n"; -while () { - chop; - next if !length; - if (/^(.*)\s+=>\s+(.*)$/) { - # verify if it already exists? - my ($key,$val) = ($1,$2); - if ($key =~ /^\s*$/ or $val =~ /^\s*$/) { - print "warning: broken => '$_'.\n"; - next; - } - - if (&IsParam("freshmeat") and &dbGet("freshmeat", "name", $key, "name")) { - if (&getFactoid($key)) { - &delFactoid($key); - } - } else { - &setFactInfo(lc $key, "factoid_value", $val); - $i++; - } - - print "$i... " if ($i % 100 == 0); - } else { - print "warning: invalid => '$_'.\n"; - } -} -close IN; - -print "Done.\n"; -&closeDB(); diff --git a/blootbot/scripts/vartree.pl b/blootbot/scripts/vartree.pl deleted file mode 100644 index d96fcc1..0000000 --- a/blootbot/scripts/vartree.pl +++ /dev/null @@ -1,80 +0,0 @@ -#!/usr/bin/perl -w -# hrm... - -# use strict; - -local @test; -local %test; - -$test{'hash0r'} = 2; -$test{'hegdfgsd'} = 'GSDFSDfsd'; - -push(@test,"heh."); -push(@test,\%test); - -&vartree(\%main::, 'main::'); - - -sub tree { - my ($pad, $ref, $symname) = @_; - my $padded = " " x $pad; - my @list; - my $scalar = 0; - my $size = 0; - - @list = keys %{$symname} if ($ref eq 'HASH'); - @list = @{$symname} if ($ref eq 'ARRAY'); - - foreach (@list) { - my $ref = ref $_; - - if ($ref eq 'HASH' or $ref eq 'ARRAY') { - print $padded."recursing $ref($_).\n"; - &tree($pad+2, $ref, $_); - } elsif ($ref eq '') { - $scalar++; - $size += length($_); - } - } - print $padded."scalars $scalar, size $size\n"; -} - -sub vartree { - my ($package, $packname) = @_; - my $symname; - - # scalar. - foreach $symname (sort keys %$package) { - local *sym = $$package{$symname}; - next unless (defined $sym); - print "scalar => $symname = '$sym'\n"; - } - - # array. - foreach $symname (sort keys %$package) { - local *sym = $$package{$symname}; - next unless (defined @sym); - print "\@$symname\n"; - &tree(2, "ARRAY", $symname); - } - - # hash. - foreach $symname (sort keys %$package) { - local *sym = $$package{$symname}; - next unless (defined %sym); - print "\%$symname\n"; - &tree(2, "HASH", $symname); - } - - foreach $symname (sort keys %$package) { - local *sym = $$package{$symname}; - next unless (defined %sym); - next unless ($symname =~ /::/); - next if ($symname eq 'main::'); - - print "recurse: $symname.\n"; - &vartree(\%sym, $symname); - } - - print "end.\n"; -} diff --git a/blootbot/scripts/webbackup.pl b/blootbot/scripts/webbackup.pl deleted file mode 100755 index ce6412e..0000000 --- a/blootbot/scripts/webbackup.pl +++ /dev/null @@ -1,95 +0,0 @@ -#!/usr/bin/perl -w - -use strict; -use LWP; -use POSIX qw(strftime); - -my $backup_interval = 1; # every: 1,7,14,30. -my $backup_count = 7; -my $backup_url = "http://core.junker.org/~apt/tables.tar.bz2"; -my $backup_file = "tables-##DATE.tar.bz2"; -my $backup_destdir = "/home/xk/public_html/"; -my $backup_indexfile = "tables-index.txt"; - -my %index; - -# Usage: &getURL($url); -sub getURL { - my ($url) = @_; - my ($ua,$res,$req); - - $ua = new LWP::UserAgent; -### $ua->proxy('http', $proxy); - - $req = new HTTP::Request('GET',$url); - $res = $ua->request($req); - - # return NULL upon error. - if ($res->is_success) { - return $res->content; - } else { - print "error: failure.\n"; - exit 1; - } -} - -#... -if ( -f "$backup_destdir/$backup_indexfile") { - if (open(INDEX, "$backup_destdir/$backup_indexfile")) { - while () { - chop; - - # days since 1970, file. - if (/^(\d+) (\S+)$/) { - $index{$1} = $2; - } - } - close INDEX; - } else { - print "WARNING: can't open $backup_indexfile.\n"; - } -} -my $now_days = (localtime)[7] + (((localtime)[5] - 70) * 365); -my $now_date = strftime("%Y%m%d", localtime); - -if (scalar keys %index) { - my $last_days = (sort {$b <=> $a} keys %index)[0]; - - if ($now_days - $last_days < $backup_interval) { - print "error: shouldn't run today.\n"; - goto cycle; - } -} - -$backup_file =~ s/##DATE/$now_date/; -print "backup_file => '$backup_file'.\n"; -if ( -f $backup_file) { - print "error: $backup_file already exists.\n"; - exit 1; -} - -my $file = &getURL($backup_url); -open(OUT,">$backup_destdir/$backup_file"); -print OUT $file; -close OUT; - -$index{$now_days} = $backup_file; -cycle:; -my @index = sort {$b <=> $a} keys %index; - -open(OUT,">$backup_destdir/$backup_indexfile"); -for(my $i=0; $i '$day'.\n"; - - if ($backup_count - 1 >= $i) { - print "DEBUG: $day $index{$day}\n"; - print OUT "$day $index{$day}\n"; - } else { - print "Deleting $index{$day}\n"; - unlink $backup_destdir."/".$index{$day}; - } -} -close OUT; - -print "Done.\n"; diff --git a/blootbot/setup/README b/blootbot/setup/README deleted file mode 100644 index 961d91a..0000000 --- a/blootbot/setup/README +++ /dev/null @@ -1,22 +0,0 @@ -Welcome, - -This directory has changed slightly. The new format allows for -each type of database to have its own schema. The following -directories are included: - - mysql/ -- Schema for the popular MySQL - sqlite/ -- Schema for v2 or v3 of SQLite - sqlite2/ -- Schema for specifically v2 of SQLite - pgsql/ -- Schema for PostgreSQL - -Also, the included setup.pl has been modified to work with -all of the above types of databases. (FIXME: actually, only -MySQL until I actually change it) - -To automate the setup of your database and user, type: - - cd ~/blootbotdir - ./setup/setup.pl - -(NOTE: The setup will ask for an account capable of administrating -the database server!) diff --git a/blootbot/setup/mysql/botmail.sql b/blootbot/setup/mysql/botmail.sql deleted file mode 100644 index 2789338..0000000 --- a/blootbot/setup/mysql/botmail.sql +++ /dev/null @@ -1,8 +0,0 @@ -CREATE TABLE botmail ( - srcwho VARCHAR(20) NOT NULL, - dstwho VARCHAR(20) NOT NULL, - srcuh VARCHAR(80) NOT NULL, - time INT UNSIGNED DEFAULT 'UNIX_TIMESTAMP()', - msg TEXT NOT NULL, - PRIMARY KEY (srcwho,dstwho) -); diff --git a/blootbot/setup/mysql/connections.sql b/blootbot/setup/mysql/connections.sql deleted file mode 100644 index 00dbf49..0000000 --- a/blootbot/setup/mysql/connections.sql +++ /dev/null @@ -1,9 +0,0 @@ -CREATE TABLE connections ( - server VARCHAR(30) NOT NULL, - port INT NOT NULL DEFAULT '6667', - nick VARCHAR(20) NOT NULL, - nickservpass VARCHAR(8) NOT NULL, - ircname VARCHAR (20) NOT NULL DEFAULT 'blootbot experimental bot', - timeadded INT UNSIGNED DEFAULT 'UNIX_TIMESTAMP()', - PRIMARY KEY (server,port,nick) -); diff --git a/blootbot/setup/mysql/factoids.sql b/blootbot/setup/mysql/factoids.sql deleted file mode 100644 index d5189d0..0000000 --- a/blootbot/setup/mysql/factoids.sql +++ /dev/null @@ -1,14 +0,0 @@ -CREATE TABLE factoids ( - factoid_key VARCHAR(64) NOT NULL, - requested_by VARCHAR(64) NOT NULL DEFAULT 'nobody', - requested_time INT NOT NULL DEFAULT '0', - requested_count SMALLINT UNSIGNED NOT NULL DEFAULT '0', - created_by VARCHAR(64), - created_time INT NOT NULL DEFAULT '0', - modified_by VARCHAR(192), - modified_time INT NOT NULL DEFAULT '0', - locked_by VARCHAR(64), - locked_time INT NOT NULL DEFAULT '0', - factoid_value TEXT NOT NULL, - PRIMARY KEY (factoid_key) -); diff --git a/blootbot/setup/mysql/freshmeat.sql b/blootbot/setup/mysql/freshmeat.sql deleted file mode 100644 index 4b4f42b..0000000 --- a/blootbot/setup/mysql/freshmeat.sql +++ /dev/null @@ -1,8 +0,0 @@ -CREATE TABLE freshmeat ( - projectname_short VARCHAR(64) NOT NULL, - latest_version VARCHAR(32) DEFAULT 'none' NOT NULL, - license VARCHAR(32), - url_homepage VARCHAR(128), - desc_short VARCHAR(96) NOT NULL, - PRIMARY KEY (projectname_short,latest_version) -); diff --git a/blootbot/setup/mysql/news.sql b/blootbot/setup/mysql/news.sql deleted file mode 100644 index ebfb0e2..0000000 --- a/blootbot/setup/mysql/news.sql +++ /dev/null @@ -1,7 +0,0 @@ -CREATE TABLE news ( - channel VARCHAR(16) NOT NULL, - id INT UNSIGNED DEFAULT '0', - key VARCHAR(16) NOT NULL, - value TEXT NOT NULL, # limit to ~450 or so. - PRIMARY KEY (channel,id,key) -); diff --git a/blootbot/setup/mysql/onjoin.sql b/blootbot/setup/mysql/onjoin.sql deleted file mode 100644 index 994cc54..0000000 --- a/blootbot/setup/mysql/onjoin.sql +++ /dev/null @@ -1,14 +0,0 @@ -CREATE TABLE onjoin ( - nick VARCHAR(20) NOT NULL, - channel VARCHAR(16) NOT NULL, - message VARCHAR(255) NOT NULL, - modified_by VARCHAR(20) NOT NULL DEFAULT 'nobody', - modified_time INT NOT NULL DEFAULT '0', - PRIMARY KEY (nick, channel) -); - --- v.2 -> v.3 --- ALTER TABLE onjoin ADD COLUMN modified_by VARCHAR(20) NOT NULL DEFAULT 'nobody'; --- ALTER TABLE onjoin ADD COLUMN modified_time INT NOT NULL DEFAULT '0'; --- ** the following doesn't work for sqlite ** --- ALTER TABLE onjoin ADD PRIMARY KEY (nick, channel); diff --git a/blootbot/setup/mysql/rootwarn.sql b/blootbot/setup/mysql/rootwarn.sql deleted file mode 100644 index afcee2c..0000000 --- a/blootbot/setup/mysql/rootwarn.sql +++ /dev/null @@ -1,8 +0,0 @@ -CREATE TABLE rootwarn ( - nick VARCHAR(20) NOT NULL, - attempt SMALLINT UNSIGNED, - time INT NOT NULL, - host VARCHAR(80) NOT NULL, - channel VARCHAR(20) NOT NULL, - PRIMARY KEY (nick) -); diff --git a/blootbot/setup/mysql/seen.sql b/blootbot/setup/mysql/seen.sql deleted file mode 100644 index d920f79..0000000 --- a/blootbot/setup/mysql/seen.sql +++ /dev/null @@ -1,8 +0,0 @@ -CREATE TABLE seen ( - nick VARCHAR(20) NOT NULL, - time INT NOT NULL, - channel VARCHAR(20) NOT NULL, - host VARCHAR(80) NOT NULL, - message TINYTEXT NOT NULL, - PRIMARY KEY (nick,channel) -); diff --git a/blootbot/setup/mysql/stats.sql b/blootbot/setup/mysql/stats.sql deleted file mode 100644 index 97f773c..0000000 --- a/blootbot/setup/mysql/stats.sql +++ /dev/null @@ -1,8 +0,0 @@ -CREATE TABLE stats ( - nick VARCHAR(20) NOT NULL, - type VARCHAR(8) NOT NULL, - channel VARCHAR(16) NOT NULL DEFAULT "PRIVATE", - time INT UNSIGNED DEFAULT 'UNIX_TIMESTAMP()', - counter SMALLINT UNSIGNED DEFAULT '0', - PRIMARY KEY (nick,type,channel) -); diff --git a/blootbot/setup/mysql/uptime.sql b/blootbot/setup/mysql/uptime.sql deleted file mode 100644 index 373902a..0000000 --- a/blootbot/setup/mysql/uptime.sql +++ /dev/null @@ -1,6 +0,0 @@ -CREATE TABLE uptime ( - uptime INT UNSIGNED DEFAULT '0', # start. - endtime INT UNSIGNED DEFAULT '0', # end. - string VARCHAR(128) NOT NULL, - PRIMARY KEY (uptime) -); diff --git a/blootbot/setup/pgsql/botmail.sql b/blootbot/setup/pgsql/botmail.sql deleted file mode 100644 index c87c2e4..0000000 --- a/blootbot/setup/pgsql/botmail.sql +++ /dev/null @@ -1,12 +0,0 @@ -CREATE TABLE botmail ( - srcwho character varying(20) NOT NULL, - dstwho character varying(20) NOT NULL, - srcuh character varying(80) NOT NULL, - "time" numeric DEFAULT 0 NOT NULL, - msg text NOT NULL -) WITHOUT OIDS; - -REVOKE ALL ON TABLE botmail FROM PUBLIC; - -ALTER TABLE ONLY botmail - ADD CONSTRAINT botmail_pkey PRIMARY KEY (srcwho, dstwho); diff --git a/blootbot/setup/pgsql/connections.sql b/blootbot/setup/pgsql/connections.sql deleted file mode 100644 index d12244c..0000000 --- a/blootbot/setup/pgsql/connections.sql +++ /dev/null @@ -1,13 +0,0 @@ -CREATE TABLE connections ( - server character varying(30) NOT NULL, - port integer DEFAULT 6667 NOT NULL, - nick character varying(20) NOT NULL, - nickservpass character varying(8) NOT NULL, - ircname character varying(20) DEFAULT 'blootbot IRC bot'::character varying NOT NULL, - timeadded numeric DEFAULT 0 -) WITHOUT OIDS; - -REVOKE ALL ON TABLE connections FROM PUBLIC; - -ALTER TABLE ONLY connections - ADD CONSTRAINT connections_pkey PRIMARY KEY (server, port, nick); diff --git a/blootbot/setup/pgsql/factoids.sql b/blootbot/setup/pgsql/factoids.sql deleted file mode 100644 index 7fc8d79..0000000 --- a/blootbot/setup/pgsql/factoids.sql +++ /dev/null @@ -1,20 +0,0 @@ -CREATE TABLE factoids ( - factoid_key VARCHAR(64) NOT NULL, - requested_by VARCHAR(80) DEFAULT 'nobody' NOT NULL, - requested_time numeric(11) DEFAULT 0 NOT NULL, - requested_count numeric(5) DEFAULT 0 NOT NULL, - created_by VARCHAR(80), - created_time numeric(11) DEFAULT 0 NOT NULL, - modified_by VARCHAR(80), - modified_time numeric(11) DEFAULT 0 NOT NULL, - locked_by VARCHAR(80), - locked_time numeric(11) DEFAULT 0 NOT NULL, - factoid_value text NOT NULL -) WITHOUT OIDS; - -REVOKE ALL ON TABLE factoids FROM PUBLIC; - -CREATE INDEX factoids_idx_fvalue ON factoids USING hash (factoid_value); - -ALTER TABLE ONLY factoids - ADD CONSTRAINT factoids_pkey_fkey PRIMARY KEY (factoid_key); diff --git a/blootbot/setup/pgsql/freshmeat.sql b/blootbot/setup/pgsql/freshmeat.sql deleted file mode 100644 index 873e2dd..0000000 --- a/blootbot/setup/pgsql/freshmeat.sql +++ /dev/null @@ -1,12 +0,0 @@ -CREATE TABLE freshmeat ( - projectname_short VARCHAR(64) NOT NULL, - latest_version VARCHAR(32) DEFAULT 'none'::VARCHAR NOT NULL, - license VARCHAR(32), - url_homepage VARCHAR(128), - desc_short VARCHAR(96) NOT NULL -) WITHOUT OIDS; - -REVOKE ALL ON TABLE freshmeat FROM PUBLIC; - -ALTER TABLE ONLY freshmeat - ADD CONSTRAINT freshmeat_pkey PRIMARY KEY (projectname_short, latest_version); diff --git a/blootbot/setup/pgsql/news.sql b/blootbot/setup/pgsql/news.sql deleted file mode 100644 index 2924c61..0000000 --- a/blootbot/setup/pgsql/news.sql +++ /dev/null @@ -1,11 +0,0 @@ -CREATE TABLE news ( - channel VARCHAR(16) NOT NULL, - id numeric DEFAULT 0 NOT NULL, - "key" VARCHAR(16) NOT NULL, - value text NOT NULL -) WITHOUT OIDS; - -REVOKE ALL ON TABLE news FROM PUBLIC; - -ALTER TABLE ONLY news - ADD CONSTRAINT news_pkey PRIMARY KEY (channel, id, "key"); diff --git a/blootbot/setup/pgsql/onjoin.sql b/blootbot/setup/pgsql/onjoin.sql deleted file mode 100644 index 2e7ed75..0000000 --- a/blootbot/setup/pgsql/onjoin.sql +++ /dev/null @@ -1,12 +0,0 @@ -CREATE TABLE onjoin ( - nick VARCHAR(20) NOT NULL, - channel VARCHAR(16) NOT NULL, - message VARCHAR(255) NOT NULL, - modified_by VARCHAR(20) DEFAULT 'nobody' NOT NULL, - modified_time numeric DEFAULT 0 NOT NULL -) WITHOUT OIDS; - -REVOKE ALL ON TABLE onjoin FROM PUBLIC; - -ALTER TABLE ONLY onjoin - ADD CONSTRAINT onjoin_pkey PRIMARY KEY (nick, channel); diff --git a/blootbot/setup/pgsql/rootwarn.sql b/blootbot/setup/pgsql/rootwarn.sql deleted file mode 100644 index 6a843d8..0000000 --- a/blootbot/setup/pgsql/rootwarn.sql +++ /dev/null @@ -1,12 +0,0 @@ -CREATE TABLE rootwarn ( - nick VARCHAR(20) NOT NULL, - attempt numeric, - "time" numeric NOT NULL, - host VARCHAR(80) NOT NULL, - channel VARCHAR(20) NOT NULL -) WITHOUT OIDS; - -REVOKE ALL ON TABLE rootwarn FROM PUBLIC; - -ALTER TABLE ONLY rootwarn - ADD CONSTRAINT rootwarn_pkey PRIMARY KEY (nick); diff --git a/blootbot/setup/pgsql/seen.sql b/blootbot/setup/pgsql/seen.sql deleted file mode 100644 index 550f5bf..0000000 --- a/blootbot/setup/pgsql/seen.sql +++ /dev/null @@ -1,14 +0,0 @@ -CREATE TABLE seen ( - nick VARCHAR(20) NOT NULL, - "time" numeric NOT NULL, - channel VARCHAR(20) NOT NULL, - host VARCHAR(80) NOT NULL, - message text NOT NULL, - hehcount numeric DEFAULT 0 NOT NULL, - messagecount numeric DEFAULT 0 NOT NULL -) WITHOUT OIDS; - -REVOKE ALL ON TABLE seen FROM PUBLIC; - -ALTER TABLE ONLY seen - ADD CONSTRAINT seen_pkey PRIMARY KEY (nick, channel); diff --git a/blootbot/setup/pgsql/stats.sql b/blootbot/setup/pgsql/stats.sql deleted file mode 100644 index 4af863d..0000000 --- a/blootbot/setup/pgsql/stats.sql +++ /dev/null @@ -1,12 +0,0 @@ -CREATE TABLE stats ( - nick VARCHAR(20) NOT NULL, - "type" VARCHAR(8) NOT NULL, - channel VARCHAR(16) DEFAULT 'PRIVATE' NOT NULL, - "time" numeric DEFAULT 0 NOT NULL, - counter numeric DEFAULT 0 -) WITHOUT OIDS; - -REVOKE ALL ON TABLE stats FROM PUBLIC; - -ALTER TABLE ONLY stats - ADD CONSTRAINT stats_pkey PRIMARY KEY (nick, "type", channel); diff --git a/blootbot/setup/pgsql/uptime.sql b/blootbot/setup/pgsql/uptime.sql deleted file mode 100644 index 49bcd63..0000000 --- a/blootbot/setup/pgsql/uptime.sql +++ /dev/null @@ -1,10 +0,0 @@ -CREATE TABLE uptime ( - uptime numeric DEFAULT 0, - endtime numeric DEFAULT 0, - string VARCHAR(128) NOT NULL -) WITHOUT OIDS; - -REVOKE ALL ON TABLE uptime FROM PUBLIC; - -ALTER TABLE ONLY uptime - ADD CONSTRAINT uptime_pkey PRIMARY KEY (uptime); diff --git a/blootbot/setup/setup.pl b/blootbot/setup/setup.pl deleted file mode 100755 index 4977b02..0000000 --- a/blootbot/setup/setup.pl +++ /dev/null @@ -1,97 +0,0 @@ -#!/usr/bin/perl -# setup_tables: setup MYSQL/PGSQL side of things for blootbot. -# written by the xk. -### - -require "src/logger.pl"; -require "src/core.pl"; -require "src/modules.pl"; -require "src/Misc.pl"; -require "src/CLI/Support.pl"; - -$bot_src_dir = "src/"; - -# read param stuff from blootbot.config. -&loadConfig("files/blootbot.config"); - -&loadDBModules(); -my $dbname = $param{'DBName'}; -my $query; - -if ($dbname eq "") { - print "error: appears that the config file was not loaded properly.\n"; - exit 1; -} - -if ($param{'DBType'} =~ /mysql/i) { - use DBI; - - print "Enter root information...\n"; - # username. - print "Username: "; - chop (my $adminuser = ); - - # passwd. - system "stty -echo"; - print "Password: "; - chop(my $adminpass = ); - print "\n"; - system "stty echo"; - - if ($adminuser eq "" or $adminpass eq "") { - &ERROR("error: adminuser || adminpass is NULL."); - exit 1; - } - - &sqlOpenDB("mysql", "mysql", $adminuser, $adminpass); - - my $database_exists = 0; - foreach $database (&sqlRawReturn("SHOW DATABASES")) { - $database_exists++ if $database eq $param{DBName}; - } - if ($database_exists) { - &status("Database '$param{DBName}' already exists. Continuing..."); - } else { - &status("Creating db ..."); - &sqlRaw("create(database)", "CREATE DATABASE $param{DBName}"); - } - - &status("--- Adding user information for user '$param{'SQLUser'}'"); - - if (!&sqlSelect("user", "user", { 'user' => &sqlQuote($param{'SQLUser'}) })) { - &status("--- Adding user '$param{'SQLUser'}' $dbname/user table..."); - - $query = "INSERT INTO user VALUES ". - "('localhost', '$param{'SQLUser'}', ". - "password('$param{'SQLPass'}'), "; - - $query .= "'Y','Y','Y','Y','Y','Y','N','N','N','N','N','N','N','N')"; - - &sqlRaw("create(user)", $query); - } else { - &status("... user information already present."); - } - - if (!&sqlSelect("db", "db", { 'db' => &sqlQuote($param{'SQLUser'}) })) { - &status("--- Adding database information for database '$dbname'."); - - $query = "INSERT INTO db VALUES ". - "('localhost', '$dbname', ". - "'$param{'SQLUser'}', "; - - $query .= "'Y','Y','Y','Y','Y','Y','Y','N','N','N')"; - - &sqlRaw("create(db)", $query); - } else { - &status("... db info already present."); - } - - # flush. - &status("Flushing privileges..."); - $query = "FLUSH PRIVILEGES"; - &sqlRaw("mysql(flush)", $query); -} - -&status("Done."); - -&sqlCloseDB(); diff --git a/blootbot/setup/sqlite/botmail.sql b/blootbot/setup/sqlite/botmail.sql deleted file mode 100644 index 2789338..0000000 --- a/blootbot/setup/sqlite/botmail.sql +++ /dev/null @@ -1,8 +0,0 @@ -CREATE TABLE botmail ( - srcwho VARCHAR(20) NOT NULL, - dstwho VARCHAR(20) NOT NULL, - srcuh VARCHAR(80) NOT NULL, - time INT UNSIGNED DEFAULT 'UNIX_TIMESTAMP()', - msg TEXT NOT NULL, - PRIMARY KEY (srcwho,dstwho) -); diff --git a/blootbot/setup/sqlite/connections.sql b/blootbot/setup/sqlite/connections.sql deleted file mode 100644 index 00dbf49..0000000 --- a/blootbot/setup/sqlite/connections.sql +++ /dev/null @@ -1,9 +0,0 @@ -CREATE TABLE connections ( - server VARCHAR(30) NOT NULL, - port INT NOT NULL DEFAULT '6667', - nick VARCHAR(20) NOT NULL, - nickservpass VARCHAR(8) NOT NULL, - ircname VARCHAR (20) NOT NULL DEFAULT 'blootbot experimental bot', - timeadded INT UNSIGNED DEFAULT 'UNIX_TIMESTAMP()', - PRIMARY KEY (server,port,nick) -); diff --git a/blootbot/setup/sqlite/factoids.sql b/blootbot/setup/sqlite/factoids.sql deleted file mode 100644 index d5189d0..0000000 --- a/blootbot/setup/sqlite/factoids.sql +++ /dev/null @@ -1,14 +0,0 @@ -CREATE TABLE factoids ( - factoid_key VARCHAR(64) NOT NULL, - requested_by VARCHAR(64) NOT NULL DEFAULT 'nobody', - requested_time INT NOT NULL DEFAULT '0', - requested_count SMALLINT UNSIGNED NOT NULL DEFAULT '0', - created_by VARCHAR(64), - created_time INT NOT NULL DEFAULT '0', - modified_by VARCHAR(192), - modified_time INT NOT NULL DEFAULT '0', - locked_by VARCHAR(64), - locked_time INT NOT NULL DEFAULT '0', - factoid_value TEXT NOT NULL, - PRIMARY KEY (factoid_key) -); diff --git a/blootbot/setup/sqlite/freshmeat.sql b/blootbot/setup/sqlite/freshmeat.sql deleted file mode 100644 index 4b4f42b..0000000 --- a/blootbot/setup/sqlite/freshmeat.sql +++ /dev/null @@ -1,8 +0,0 @@ -CREATE TABLE freshmeat ( - projectname_short VARCHAR(64) NOT NULL, - latest_version VARCHAR(32) DEFAULT 'none' NOT NULL, - license VARCHAR(32), - url_homepage VARCHAR(128), - desc_short VARCHAR(96) NOT NULL, - PRIMARY KEY (projectname_short,latest_version) -); diff --git a/blootbot/setup/sqlite/news.sql b/blootbot/setup/sqlite/news.sql deleted file mode 100644 index ebfb0e2..0000000 --- a/blootbot/setup/sqlite/news.sql +++ /dev/null @@ -1,7 +0,0 @@ -CREATE TABLE news ( - channel VARCHAR(16) NOT NULL, - id INT UNSIGNED DEFAULT '0', - key VARCHAR(16) NOT NULL, - value TEXT NOT NULL, # limit to ~450 or so. - PRIMARY KEY (channel,id,key) -); diff --git a/blootbot/setup/sqlite/onjoin.sql b/blootbot/setup/sqlite/onjoin.sql deleted file mode 100644 index 994cc54..0000000 --- a/blootbot/setup/sqlite/onjoin.sql +++ /dev/null @@ -1,14 +0,0 @@ -CREATE TABLE onjoin ( - nick VARCHAR(20) NOT NULL, - channel VARCHAR(16) NOT NULL, - message VARCHAR(255) NOT NULL, - modified_by VARCHAR(20) NOT NULL DEFAULT 'nobody', - modified_time INT NOT NULL DEFAULT '0', - PRIMARY KEY (nick, channel) -); - --- v.2 -> v.3 --- ALTER TABLE onjoin ADD COLUMN modified_by VARCHAR(20) NOT NULL DEFAULT 'nobody'; --- ALTER TABLE onjoin ADD COLUMN modified_time INT NOT NULL DEFAULT '0'; --- ** the following doesn't work for sqlite ** --- ALTER TABLE onjoin ADD PRIMARY KEY (nick, channel); diff --git a/blootbot/setup/sqlite/rootwarn.sql b/blootbot/setup/sqlite/rootwarn.sql deleted file mode 100644 index afcee2c..0000000 --- a/blootbot/setup/sqlite/rootwarn.sql +++ /dev/null @@ -1,8 +0,0 @@ -CREATE TABLE rootwarn ( - nick VARCHAR(20) NOT NULL, - attempt SMALLINT UNSIGNED, - time INT NOT NULL, - host VARCHAR(80) NOT NULL, - channel VARCHAR(20) NOT NULL, - PRIMARY KEY (nick) -); diff --git a/blootbot/setup/sqlite/seen.sql b/blootbot/setup/sqlite/seen.sql deleted file mode 100644 index d920f79..0000000 --- a/blootbot/setup/sqlite/seen.sql +++ /dev/null @@ -1,8 +0,0 @@ -CREATE TABLE seen ( - nick VARCHAR(20) NOT NULL, - time INT NOT NULL, - channel VARCHAR(20) NOT NULL, - host VARCHAR(80) NOT NULL, - message TINYTEXT NOT NULL, - PRIMARY KEY (nick,channel) -); diff --git a/blootbot/setup/sqlite/stats.sql b/blootbot/setup/sqlite/stats.sql deleted file mode 100644 index 97f773c..0000000 --- a/blootbot/setup/sqlite/stats.sql +++ /dev/null @@ -1,8 +0,0 @@ -CREATE TABLE stats ( - nick VARCHAR(20) NOT NULL, - type VARCHAR(8) NOT NULL, - channel VARCHAR(16) NOT NULL DEFAULT "PRIVATE", - time INT UNSIGNED DEFAULT 'UNIX_TIMESTAMP()', - counter SMALLINT UNSIGNED DEFAULT '0', - PRIMARY KEY (nick,type,channel) -); diff --git a/blootbot/setup/sqlite/uptime.sql b/blootbot/setup/sqlite/uptime.sql deleted file mode 100644 index 373902a..0000000 --- a/blootbot/setup/sqlite/uptime.sql +++ /dev/null @@ -1,6 +0,0 @@ -CREATE TABLE uptime ( - uptime INT UNSIGNED DEFAULT '0', # start. - endtime INT UNSIGNED DEFAULT '0', # end. - string VARCHAR(128) NOT NULL, - PRIMARY KEY (uptime) -); diff --git a/blootbot/setup/sqlite2/botmail.sql b/blootbot/setup/sqlite2/botmail.sql deleted file mode 100644 index 2789338..0000000 --- a/blootbot/setup/sqlite2/botmail.sql +++ /dev/null @@ -1,8 +0,0 @@ -CREATE TABLE botmail ( - srcwho VARCHAR(20) NOT NULL, - dstwho VARCHAR(20) NOT NULL, - srcuh VARCHAR(80) NOT NULL, - time INT UNSIGNED DEFAULT 'UNIX_TIMESTAMP()', - msg TEXT NOT NULL, - PRIMARY KEY (srcwho,dstwho) -); diff --git a/blootbot/setup/sqlite2/connections.sql b/blootbot/setup/sqlite2/connections.sql deleted file mode 100644 index 00dbf49..0000000 --- a/blootbot/setup/sqlite2/connections.sql +++ /dev/null @@ -1,9 +0,0 @@ -CREATE TABLE connections ( - server VARCHAR(30) NOT NULL, - port INT NOT NULL DEFAULT '6667', - nick VARCHAR(20) NOT NULL, - nickservpass VARCHAR(8) NOT NULL, - ircname VARCHAR (20) NOT NULL DEFAULT 'blootbot experimental bot', - timeadded INT UNSIGNED DEFAULT 'UNIX_TIMESTAMP()', - PRIMARY KEY (server,port,nick) -); diff --git a/blootbot/setup/sqlite2/factoids.sql b/blootbot/setup/sqlite2/factoids.sql deleted file mode 100644 index d5189d0..0000000 --- a/blootbot/setup/sqlite2/factoids.sql +++ /dev/null @@ -1,14 +0,0 @@ -CREATE TABLE factoids ( - factoid_key VARCHAR(64) NOT NULL, - requested_by VARCHAR(64) NOT NULL DEFAULT 'nobody', - requested_time INT NOT NULL DEFAULT '0', - requested_count SMALLINT UNSIGNED NOT NULL DEFAULT '0', - created_by VARCHAR(64), - created_time INT NOT NULL DEFAULT '0', - modified_by VARCHAR(192), - modified_time INT NOT NULL DEFAULT '0', - locked_by VARCHAR(64), - locked_time INT NOT NULL DEFAULT '0', - factoid_value TEXT NOT NULL, - PRIMARY KEY (factoid_key) -); diff --git a/blootbot/setup/sqlite2/freshmeat.sql b/blootbot/setup/sqlite2/freshmeat.sql deleted file mode 100644 index 4b4f42b..0000000 --- a/blootbot/setup/sqlite2/freshmeat.sql +++ /dev/null @@ -1,8 +0,0 @@ -CREATE TABLE freshmeat ( - projectname_short VARCHAR(64) NOT NULL, - latest_version VARCHAR(32) DEFAULT 'none' NOT NULL, - license VARCHAR(32), - url_homepage VARCHAR(128), - desc_short VARCHAR(96) NOT NULL, - PRIMARY KEY (projectname_short,latest_version) -); diff --git a/blootbot/setup/sqlite2/news.sql b/blootbot/setup/sqlite2/news.sql deleted file mode 100644 index ebfb0e2..0000000 --- a/blootbot/setup/sqlite2/news.sql +++ /dev/null @@ -1,7 +0,0 @@ -CREATE TABLE news ( - channel VARCHAR(16) NOT NULL, - id INT UNSIGNED DEFAULT '0', - key VARCHAR(16) NOT NULL, - value TEXT NOT NULL, # limit to ~450 or so. - PRIMARY KEY (channel,id,key) -); diff --git a/blootbot/setup/sqlite2/onjoin.sql b/blootbot/setup/sqlite2/onjoin.sql deleted file mode 100644 index 994cc54..0000000 --- a/blootbot/setup/sqlite2/onjoin.sql +++ /dev/null @@ -1,14 +0,0 @@ -CREATE TABLE onjoin ( - nick VARCHAR(20) NOT NULL, - channel VARCHAR(16) NOT NULL, - message VARCHAR(255) NOT NULL, - modified_by VARCHAR(20) NOT NULL DEFAULT 'nobody', - modified_time INT NOT NULL DEFAULT '0', - PRIMARY KEY (nick, channel) -); - --- v.2 -> v.3 --- ALTER TABLE onjoin ADD COLUMN modified_by VARCHAR(20) NOT NULL DEFAULT 'nobody'; --- ALTER TABLE onjoin ADD COLUMN modified_time INT NOT NULL DEFAULT '0'; --- ** the following doesn't work for sqlite ** --- ALTER TABLE onjoin ADD PRIMARY KEY (nick, channel); diff --git a/blootbot/setup/sqlite2/rootwarn.sql b/blootbot/setup/sqlite2/rootwarn.sql deleted file mode 100644 index afcee2c..0000000 --- a/blootbot/setup/sqlite2/rootwarn.sql +++ /dev/null @@ -1,8 +0,0 @@ -CREATE TABLE rootwarn ( - nick VARCHAR(20) NOT NULL, - attempt SMALLINT UNSIGNED, - time INT NOT NULL, - host VARCHAR(80) NOT NULL, - channel VARCHAR(20) NOT NULL, - PRIMARY KEY (nick) -); diff --git a/blootbot/setup/sqlite2/seen.sql b/blootbot/setup/sqlite2/seen.sql deleted file mode 100644 index d920f79..0000000 --- a/blootbot/setup/sqlite2/seen.sql +++ /dev/null @@ -1,8 +0,0 @@ -CREATE TABLE seen ( - nick VARCHAR(20) NOT NULL, - time INT NOT NULL, - channel VARCHAR(20) NOT NULL, - host VARCHAR(80) NOT NULL, - message TINYTEXT NOT NULL, - PRIMARY KEY (nick,channel) -); diff --git a/blootbot/setup/sqlite2/stats.sql b/blootbot/setup/sqlite2/stats.sql deleted file mode 100644 index 97f773c..0000000 --- a/blootbot/setup/sqlite2/stats.sql +++ /dev/null @@ -1,8 +0,0 @@ -CREATE TABLE stats ( - nick VARCHAR(20) NOT NULL, - type VARCHAR(8) NOT NULL, - channel VARCHAR(16) NOT NULL DEFAULT "PRIVATE", - time INT UNSIGNED DEFAULT 'UNIX_TIMESTAMP()', - counter SMALLINT UNSIGNED DEFAULT '0', - PRIMARY KEY (nick,type,channel) -); diff --git a/blootbot/setup/sqlite2/uptime.sql b/blootbot/setup/sqlite2/uptime.sql deleted file mode 100644 index 373902a..0000000 --- a/blootbot/setup/sqlite2/uptime.sql +++ /dev/null @@ -1,6 +0,0 @@ -CREATE TABLE uptime ( - uptime INT UNSIGNED DEFAULT '0', # start. - endtime INT UNSIGNED DEFAULT '0', # end. - string VARCHAR(128) NOT NULL, - PRIMARY KEY (uptime) -); diff --git a/blootbot/src/CLI/Support.pl b/blootbot/src/CLI/Support.pl deleted file mode 100644 index 7ee3a0b..0000000 --- a/blootbot/src/CLI/Support.pl +++ /dev/null @@ -1,103 +0,0 @@ -# -# CLI/Support.pl: Stubs for functions that are from IRC/* -# Author: Tim Riker -# Version: v0.1 (20021028) -# Created: 20021028 -# -use strict; - -my $postprocess; - -use vars qw($uh $message); - -sub cliloop { - &status("Using CLI..."); - &status("Now type what you want."); - - $nuh = "local!local\@local"; - $uh = "local\@local"; - $who = 'local'; - $orig{who} = 'local'; - $ident = $param{'ircUser'}; - $chan = $talkchannel = "_local"; - $addressed = 1; - $msgType = 'private'; - $host = 'local'; - - # install libterm-readline-gnu-perl to get history support - use Term::ReadLine; - my $term = new Term::ReadLine 'blootbot'; - my $prompt = "$who> "; - #$OUT = $term->OUT || STDOUT; - while ( defined ($_ = $term->readline($prompt)) ) { - $orig{message} = $_; - $message = $_; - chomp $message; - last if ($message =~ m/^quit$/); - $_ = &process() if $message; - } - &doExit(); -} - -sub msg { - my ($nick, $msg) = @_; - if (!defined $nick) { - &ERROR("msg: nick == NULL."); - return; - } - - if (!defined $msg) { - $msg ||= 'NULL'; - &WARN("msg: msg == $msg."); - return; - } - - if ( $postprocess ) { - undef $postprocess; - } elsif ($postprocess = &getChanConf('postprocess', $talkchannel)) { - &DEBUG("say: $postprocess $msg"); - &parseCmdHook($postprocess . ' ' . $msg); - undef $postprocess; - return; - } - - &status(">$nick< $msg"); - - print("$nick: $msg\n"); -} - -# Usage: &action(nick || chan, txt); -sub action { - my ($target, $txt) = @_; - if (!defined $txt) { - &WARN("action: txt == NULL."); - return; - } - - if (length $txt > 480) { - &status("action: txt too long; truncating."); - chop($txt) while (length $txt > 480); - } - - &status("* $ident/$target $txt"); -} - -sub IsNickInChan { - my ($nick,$chan) = @_; - return 1; -} - -sub performStrictReply { - &msg($who, @_); -} - -sub performReply { - &msg($who, @_); -} - -sub performAddressedReply { - return unless ($addressed); - &msg($who, @_); -} - -1; diff --git a/blootbot/src/CommandStubs.pl b/blootbot/src/CommandStubs.pl deleted file mode 100644 index 00e1eba..0000000 --- a/blootbot/src/CommandStubs.pl +++ /dev/null @@ -1,916 +0,0 @@ -# -# User Command Extension Stubs -# WARN: this file does not reload on HUP. -# - -#use strict; # TODO: sub { \&{ $hash{'CODEREF'} }($flatarg) }; - -use vars qw($who $msgType $conn $chan $message $ident $talkchannel - $bot_version $bot_data_dir); -use vars qw(@vernick @vernicktodo); -use vars qw(%channels %cache %mask %userstats %myModules %cmdstats - %cmdhooks %lang %ver); -# TODO: FIX THE FOLLOWING: -use vars qw($total $x $type $i $good %wingateToDo); - -### COMMAND HOOK IMPLEMENTATION. -# addCmdHook('TEXT_HOOK', -# (CODEREF => 'Blah', -# Forker => 1, -# Module => 'blah.pl' # preload module. -# Identifier => 'config_label', # change to Config? -# Help => 'help_label', -# Cmdstats => 'text_label',) -#} -### - -sub addCmdHook { - my ($ident, %hash) = @_; - - if (exists $cmdhooks{$ident}) { - &WARN("aCH: \$cmdhooks{$ident} already exists."); - return; - } - - &VERB("aCH: added $ident",2); # use $hash{'Identifier'}? - ### hrm... prevent warnings? - $cmdhooks{$ident} = \%hash; -} - -# RUN IF ADDRESSED. -sub parseCmdHook { - my ($line) = @_; - $line =~ s/^\s+|\s+$//g; # again. - $line =~ /^(\S+)(\s+(.*))?$/; - my $cmd = $1; # command name is whitespaceless. - my $flatarg = $3; - my @args = split(/\s+/, $flatarg || ''); - my $done = 0; - - &shmFlush(); - - if (!defined %cmdhooks) { - &WARN('%cmdhooks does not exist.'); - return 0; - } - - if (!defined $cmd) { - &WARN('cstubs: cmd == NULL.'); - return 0; - } - - foreach (keys %cmdhooks) { - # rename to something else! like $id or $label? - my $ident = $_; - - next unless ($cmd =~ /^$ident$/i); - - if ($done) { - &WARN("pCH: Multiple hook match: $ident"); - next; - } - - &status("cmdhooks: $cmd matched '$ident' '$flatarg'"); - my %hash = %{ $cmdhooks{$ident} }; - - if (!scalar keys %hash) { - &WARN('CmdHook: hash is NULL?'); - return 1; - } - - if ($hash{NoArgs} and $flatarg) { - &DEBUG("cmd $ident does not take args ('$flatarg'); skipping."); - next; - } - - if (!exists $hash{CODEREF}) { - &ERROR("CODEREF undefined for $cmd or $ident."); - return 1; - } - - ### DEBUG. - foreach (keys %hash) { - &VERB(" $cmd->$_ => '$hash{$_}'.",2); - } - - ### HELP. - if (exists $hash{'Help'} and !scalar(@args)) { - &help( $hash{'Help'} ); - return 1; - } - - ### IDENTIFIER. - if (exists $hash{'Identifier'}) { - return 1 unless (&IsChanConfOrWarn($hash{'Identifier'})); - } - - ### USER FLAGS. - if (exists $hash{'UserFlag'}) { - return 1 unless (&hasFlag($hash{'UserFlag'})); - } - - ### FORKER,IDENTIFIER,CODEREF. - if (($$ == $bot_pid) && exists $hash{'Forker'}) { - if (exists $hash{'ArrayArgs'}) { - &Forker($hash{'Identifier'}, sub { \&{ $hash{'CODEREF'} }(@args) } ); - } else { - &Forker($hash{'Identifier'}, sub { \&{ $hash{'CODEREF'} }($flatarg) } ); - } - - } else { - if (exists $hash{'Module'}) { - &loadMyModule($hash{'Module'}); - } - - # check if CODEREF exists. - if (!defined &{ $hash{'CODEREF'} }) { - &WARN("coderef $hash{'CODEREF'} does not exist."); - if (defined $who) { - &msg($who, "coderef does not exist for $ident."); - } - - return 1; - } - - if (exists $hash{'ArrayArgs'}) { - &{ $hash{'CODEREF'} }(@args); - } else { - &{ $hash{'CODEREF'} }($flatarg); - } - } - - ### CMDSTATS. - if (exists $hash{'Cmdstats'}) { - $cmdstats{ $hash{'Cmdstats'} }++; - } - - &VERB('hooks: End of command.',2); - - $done = 1; - } - - return 1 if ($done); - return 0; -} - -sub Modules { - if (!defined $message) { - &WARN('Modules: message is undefined. should never happen.'); - return; - } - - my $debiancmd = 'conflicts?|depends?|desc|file|(?:d)?info|provides?'; - $debiancmd .= '|recommends?|suggests?|maint|maintainer'; - - if ($message =~ /^($debiancmd)(\s+(.*))?$/i) { - return unless (&IsChanConfOrWarn('Debian')); - my $package = lc $3; - - if (defined $package) { - &Forker('Debian', sub { &Debian::infoPackages($1, $package); } ); - } else { - &help($1); - } - - return; - } - - # google searching. Simon++ - my $w3search_regex = 'google'; - if ($message =~ /^(?:search\s+)?($w3search_regex)\s+(?:for\s+)?['"]?(.*?)["']?\s*\?*$/i) { - return unless (&IsChanConfOrWarn('W3Search')); - - &Forker('W3Search', sub { &W3Search::W3Search($1,$2); } ); - - $cmdstats{'W3Search'}++; - return; - } - - # text counters. (eg: hehstats) - my $itc; - $itc = &getChanConf('ircTextCounters'); - $itc = &findChanConf('ircTextCounters') unless ($itc); - return if ($itc && &do_text_counters($itc) == 1); - # end of text counters. - - # list{keys|values}. xk++. Idea taken from #linuxwarez@EFNET - if ($message =~ /^list(\S+)(\s+(.*))?$/i) { - return unless (&IsChanConfOrWarn('Search')); - - my $thiscmd = lc $1; - my $args = $3 || ''; - - $thiscmd =~ s/^vals$/values/; - return if ($thiscmd ne 'keys' && $thiscmd ne 'values'); - - # Usage: - if (!defined $args or $args =~ /^\s*$/) { - &help('list'. $thiscmd); - return; - } - - # suggested by asuffield and \broken. - if ($args =~ /^["']/ and $args =~ /["']$/) { - &DEBUG('list*: removed quotes.'); - $args =~ s/^["']|["']$//g; - } - - if (length $args < 2 && &IsFlag('o') ne 'o') { - &msg($who, 'search string is too short.'); - return; - } - - &Forker('Search', sub { &Search::Search($thiscmd, $args); } ); - - $cmdstats{'Factoid Search'}++; - return; - } - - # Topic management. xk++ - # may want to add a userflags for topic. -xk - if ($message =~ /^topic(\s+(.*))?$/i) { - return unless (&IsChanConfOrWarn('Topic')); - - my $chan = $talkchannel; - my @args = split / /, $2 || ''; - - if (!scalar @args) { - &msg($who,"Try 'help topic'"); - return; - } - - $chan = lc(shift @args) if ($msgType eq 'private'); - my $thiscmd = shift @args; - - # topic over public: - if ($msgType eq 'public' && $thiscmd =~ /^#/) { - &msg($who, 'error: channel argument is not required.'); - &msg($who, "\002Usage\002: topic "); - return; - } - - # topic over private: - if ($msgType eq 'private' && $chan !~ /^#/) { - &msg($who, 'error: channel argument is required.'); - &msg($who, "\002Usage\002: topic #channel "); - return; - } - - if (&validChan($chan) == 0) { - &msg($who,"error: invalid channel \002$chan\002"); - return; - } - - # for semi-outsiders. - if (!&IsNickInChan($who,$chan)) { - &msg($who, "Failed. You ($who) are not in $chan, hey?"); - return; - } - - # now lets do it. - &loadMyModule('Topic'); - &Topic($chan, $thiscmd, join(' ', @args)); - $cmdstats{'Topic'}++; - return; - } - - # wingate. - if ($message =~ /^wingate$/i) { - return unless (&IsChanConfOrWarn('Wingate')); - - my $reply = "Wingate statistics: scanned \002" - .scalar(keys %wingateToDo)."\002 hosts"; - my $queue = scalar(keys %wingateToDo); - if ($queue) { - $reply .= ". I have \002$queue\002 hosts in the queue"; - $reply .= '. Started the scan '.&Time2String(time() - $wingaterun).' ago'; - } - - &performStrictReply("$reply."); - - return; - } - - # do nothing and let the other routines have a go - return 'CONTINUE'; -} - -# Uptime. xk++ -sub uptime { - my $count = 1; - &msg($who, "- Uptime for $ident -"); - &msg($who, "Now: ". &Time2String(&uptimeNow()) ." running $bot_version"); - - foreach (&uptimeGetInfo()) { - /^(\d+)\.\d+ (.*)/; - my $time = &Time2String($1); - my $info = $2; - - &msg($who, "$count: $time $2"); - $count++; - } -} - -# seen. -sub seen { - my($person) = lc shift; - $person =~ s/\?*$//; - - if (!defined $person or $person =~ /^$/) { - &help('seen'); - - my $i = &countKeys('seen'); - &msg($who,'there '. &fixPlural('is',$i) ." \002$i\002 ". - 'seen '. &fixPlural('entry',$i) .' that I know of.'); - - return; - } - - my @seen; - - &seenFlush(); # very evil hack. oh well, better safe than sorry. - - # TODO: convert to &sqlSelectRowHash(); - my $select = 'nick,time,channel,host,message'; - if ($person eq 'random') { - @seen = &randKey('seen', $select); - } else { - @seen = &sqlSelect('seen', $select, { nick => $person } ); - } - - if (scalar @seen < 2) { - foreach (@seen) { - &DEBUG("seen: _ => '$_'."); - } - &performReply("i haven't seen '$person'"); - return; - } - - # valid seen. - my $reply; - ### TODO: multi channel support. may require &IsNick() to return - ### all channels or something. - - my @chans = &getNickInChans($seen[0]); - if (scalar @chans) { - $reply = "$seen[0] is currently on"; - - foreach (@chans) { - $reply .= ' '.$_; - next unless (exists $userstats{lc $seen[0]}{'Join'}); - $reply .= ' ('.&Time2String(time() - $userstats{lc $seen[0]}{'Join'}).')'; - } - - if (&IsChanConf('seenStats') > 0) { - my $i; - $i = $userstats{lc $seen[0]}{'Count'}; - $reply .= ". Has said a total of \002$i\002 messages" if (defined $i); - $i = $userstats{lc $seen[0]}{'Time'}; - $reply .= '. Is idling for '.&Time2String(time() - $i) if (defined $i); - } - $reply .= ", last said\002:\002 '$seen[4]'."; - } else { - my $howlong = &Time2String(time() - $seen[1]); - $reply = "$seen[0] <$seen[3]> was last seen on IRC ". - "in channel $seen[2], $howlong ago, ". - "saying\002:\002 '$seen[4]'."; - } - - &performStrictReply($reply); - return; -} - -# User Information Services. requested by Flugh. -sub userinfo { - my ($arg) = join(' ',@_); - - if ($arg =~ /^set(\s+(.*))?$/i) { - $arg = $2; - if (!defined $arg) { - &help('userinfo set'); - return; - } - - &UserInfoSet(split /\s+/, $arg, 2); - } elsif ($arg =~ /^unset(\s+(.*))?$/i) { - $arg = $2; - if (!defined $arg) { - &help('userinfo unset'); - return; - } - - &UserInfoSet($arg, ''); - } else { - &UserInfoGet($arg); - } -} - -# cookie (random). xk++ -sub cookie { - my ($arg) = @_; - - # lets find that secret cookie. - my $target = ($msgType ne 'public') ? $who : $talkchannel; - my $cookiemsg = &getRandom(keys %{ $lang{'cookie'} }); - my ($key,$value); - - ### WILL CHEW TONS OF MEM. - ### TODO: convert this to a Forker function! - if ($arg) { - my @list = &searchTable('factoids', 'factoid_key', 'factoid_value', $arg); - $key = &getRandom(@list); - $value = &getFactInfo($key, 'factoid_value'); - } else { - ($key,$value) = &randKey('factoids','factoid_key,factoid_value'); - } - - for ($cookiemsg) { - s/##KEY/\002$key\002/; - s/##VALUE/$value/; - s/##WHO/$who/; - s/\$who/$who/; # cheap fix. - s/(\S+)?\s*<\S+>/$1 /; - s/\s+/ /g; - } - - if ($cookiemsg =~ s/^ACTION //i) { - &action($target, $cookiemsg); - } else { - &msg($target, $cookiemsg); - } -} - -sub convert { - my $arg = join(' ',@_); - my ($from,$to) = ('',''); - - ($from,$to) = ($1,$2) if ($arg =~ /^(.*?) to (.*)$/i); - ($from,$to) = ($2,$1) if ($arg =~ /^(.*?) from (.*)$/i); - - if (!$to or !$from) { - &msg($who, 'Invalid format!'); - &help('convert'); - return; - } - - &Units::convertUnits($from, $to); - - return; -} - -sub lart { - my ($target) = &fixString($_[0]); - my $extra = 0; - my $chan = $talkchannel; - my ($for); - my $mynick = $conn->nick(); - - if ($msgType eq 'private') { - if ($target =~ /^($mask{chan})\s+(.*)$/) { - $chan = $1; - $target = $2; - $extra = 1; - } else { - &msg($who, 'error: invalid format or missing arguments.'); - &help('lart'); - return; - } - } - if ($target =~ /^(.*)(\s+for\s+.*)$/) { - $target = $1; - $for = $2; - } - - my $line = &getRandomLineFromFile($bot_data_dir. '/blootbot.lart'); - if (defined $line) { - if ($target =~ /^(me|you|itself|\Q$mynick\E)$/i) { - $line =~ s/WHO/$who/g; - } else { - $line =~ s/WHO/$target/g; - } - $line .= $for if ($for); - $line .= ", courtesy of $who" if ($extra); - - &action($chan, $line); - } else { - &status('lart: error reading file?'); - } -} - -sub DebianNew { - my $idx = 'debian/Packages-sid.idx'; - my $error = 0; - my %pkg; - my @new; - - $error++ unless ( -e $idx); - $error++ unless ( -e "$idx-old"); - - if ($error) { - $error = 'no sid/sid-old index file found.'; - &ERROR("Debian: $error"); - &msg($who, $error); - return; - } - - open(IDX1, $idx); - open(IDX2, "$idx-old"); - - while () { - chop; - next if (/^\*/); - - $pkg{$_} = 1; - } - close IDX2; - - open(IDX1,$idx); - while () { - chop; - next if (/^\*/); - next if (exists $pkg{$_}); - - push(@new, $_); - } - close IDX1; - - &::performStrictReply( &::formListReply(0, 'New debian packages:', @new) ); -} - -sub do_verstats { - my ($chan) = @_; - - if (!defined $chan) { - &help('verstats'); - return; - } - - if (!&validChan($chan)) { - &msg($who, "chan $chan is invalid."); - return; - } - - if (scalar @vernick > scalar(keys %{ $channels{lc $chan}{''} })/4) { - &msg($who, 'verstats already in progress for someone else.'); - return; - } - - &msg($who, "Sending CTCP VERSION to $chan; results in 60s."); - $conn->ctcp('VERSION', $chan); - $cache{verstats}{chan} = $chan; - $cache{verstats}{who} = $who; - $cache{verstats}{msgType} = $msgType; - - $conn->schedule(30, sub { - my $c = lc $cache{verstats}{chan}; - @vernicktodo = (); - - foreach (keys %{ $channels{$c}{''} } ) { - next if (grep /^\Q$_\E$/i, @vernick); - push(@vernicktodo, $_); - } - - &verstats_flush(); - } ); - - $conn->schedule(60, sub { - my $vtotal = 0; - my $c = lc $cache{verstats}{chan}; - my $total = keys %{ $channels{$c}{''} }; - $chan = $c; - $who = $cache{verstats}{who}; - $msgType = $cache{verstats}{msgType}; - delete $cache{verstats}; # sufficient? - - foreach (keys %ver) { - $vtotal += scalar keys %{ $ver{$_} }; - } - - my %sorted; - my $unknown = $total - $vtotal; - my $perc = sprintf("%.1f", $unknown * 100 / $total); - $perc =~ s/.0$//; - $sorted{$perc}{'unknown/cloak'} = "$unknown ($perc%)" if ($unknown); - - foreach (keys %ver) { - my $count = scalar keys %{ $ver{$_} }; - $perc = sprintf("%.01f", $count * 100 / $total); - $perc =~ s/.0$//; # lame compression. - - $sorted{$perc}{$_} = "$count ($perc%)"; - } - - ### can be compressed to a map? - my @list; - foreach ( sort { $b <=> $a } keys %sorted ) { - my $perc = $_; - foreach (sort keys %{ $sorted{$perc} }) { - push(@list, "$_ - $sorted{$perc}{$_}"); - } - } - - # hack. this is one major downside to scheduling. - $chan = $c; - &performStrictReply( &formListReply(0, "IRC Client versions for $c ", @list) ); - - # clean up not-needed data structures. - undef %ver; - undef @vernick; - } ); - - return; -} - -sub verstats_flush { - for (1..5) { - last unless (scalar @vernicktodo); - - my $n = shift(@vernicktodo); - $conn->ctcp('VERSION', $n); - } - - return unless (scalar @vernicktodo); - - $conn->schedule(3, \&verstats_flush() ); -} - -sub do_text_counters { - my ($itc) = @_; - $itc =~ s/([^\w\s])/\\$1/g; - my $z = join '|', split ' ', $itc; - - if ($msgType eq 'privmsg' and $message =~ / ($mask{chan})$/) { - &DEBUG("ircTC: privmsg detected; chan = $1"); - $chan = $1; - } - - if ($message =~ /^_stats(\s+(\S+))$/i) { - &textstats_main($2); - return 1; - } - - my ($type,$arg); - if ($message =~ /^($z)stats(\s+(\S+))?$/i) { - $type = $1; - $arg = $3; - } else { - return 0; - } - - # even more uglier with channel/time arguments. - my $c = $chan; -# my $c = $chan || 'PRIVATE'; - my $where = 'type='.&sqlQuote($type); - if (defined $c) { - &DEBUG("c => $c"); - $where .= ' AND channel='.&sqlQuote($c) if (defined $c); - } else { - &DEBUG('not using chan arg'); - } - - my $sum = (&sqlRawReturn('SELECT SUM(counter) FROM stats' - .' WHERE '.$where ))[0]; - - if (!defined $arg or $arg =~ /^\s*$/) { - # this is way ugly. - - # TODO: convert $where to hash - my %hash = &sqlSelectColHash('stats', 'nick,counter', - { }, - $where.' ORDER BY counter DESC LIMIT 3', 1 - ); - my $i; - my @top; - - # unfortunately we have to sort it again! - my $tp = 0; - foreach $i (sort { $b <=> $a } keys %hash) { - foreach (keys %{ $hash{$i} }) { - my $p = sprintf("%.01f", 100*$i/$sum); - $tp += $p; - push(@top, "\002$_\002 -- $i ($p%)"); - } - } - my $topstr = ''; - if (scalar @top) { - $topstr = '. Top '.scalar(@top).': '.join(', ', @top); - } - - if (defined $sum) { - &performStrictReply("total count of \037$type\037 on \002$c\002: $sum$topstr"); - } else { - &performStrictReply("zero counter for \037$type\037."); - } - } else { - # TODO: convert $where to hash and use a sqlSelect - my $x = (&sqlRawReturn('SELECT SUM(counter) FROM stats'. - " WHERE $where AND nick=".&sqlQuote($arg) ))[0]; - - if (!defined $x) { # !defined. - &performStrictReply("$arg has not said $type yet."); - return 1; - } - - # defined. - # TODO: convert $where to hash - my @array = &sqlSelect('stats', 'nick', undef, - $where.' ORDER BY counter', 1 - ); - my $good = 0; - my $i = 0; - for ($i=0; $i $c } : ''; - my $sum = &sqlSelect('stats', 'SUM(counter)', $where_href); - - if (!defined $arg or $arg =~ /^\s*$/) { - # this is way ugly. - &DEBUG('_stats: !arg'); - - my %hash = &sqlSelectColHash('stats', 'nick,counter', - $where_href, - ' ORDER BY counter DESC LIMIT 3', 1 - ); - my $i; - my @top; - - # unfortunately we have to sort it again! - my $tp = 0; - foreach $i (sort { $b <=> $a } keys %hash) { - foreach (keys %{ $hash{$i} }) { - my $p = sprintf("%.01f", 100*$i/$sum); - $tp += $p; - push(@top, "\002$_\002 -- $i ($p%)"); - } - } - - my $topstr = ''; - if (scalar @top) { - $topstr = '. Top '.scalar(@top).': '.join(', ', @top); - } - - if (defined $sum) { - &performStrictReply("total count of \037$type\037 on \002$c\002: $sum$topstr"); - } else { - &performStrictReply("zero counter for \037$type\037."); - } - - return; - } - - # TODO: add nick to where_href - my %hash = &sqlSelectColHash('stats', 'type,counter', - $where_href, ' AND nick='.&sqlQuote($arg) - ); - - # this is totally messed up... needs to be fixed... and cleaned up. - my $total; - my $good; - my $ii; - my $x; - - foreach (keys %hash) { - &DEBUG("_stats: hash{$_} => $hash{$_}"); - # ranking. - # TODO: convert $where to hash - my $where = ''; - my @array = &sqlSelect('stats', 'nick', undef, $where.' ORDER BY counter', 1); - $good = 0; - $ii = 0; - for(my $i=0; $i $i, good => $good, total => $total"); - $x .= ' '.$total.'blah blah'; - } - -# return; - - if (!defined $x) { # !defined. - &performStrictReply("$arg has not said $type yet."); - return; - } - - my $xtra = ''; - if ($total and $good) { - my $pct = sprintf("%.01f", 100*(1+$total-$ii)/$total); - $xtra = ", ranked $ii\002/\002$total (percentile: \002$pct\002 %)"; - } - - my $pct1 = sprintf("%.01f", 100*$x/$sum); - &performStrictReply("\002$arg\002 has said \037$type\037 \002$x\002 times (\002$pct1\002 %)$xtra"); -} - -sub nullski { - my ($arg) = @_; - return unless (defined $arg); - # big security hole - #foreach (`$arg`) { &msg($who,$_); } -} - -%cmdhooks=(); -### -### START ADDING HOOKS. -### -&addCmdHook('(babel(fish)?|x|xlate|translate)', ('CODEREF' => 'babelfish::babelfish', 'Identifier' => 'babelfish', 'Cmdstats' => 'babelfish', 'Forker' => 1, 'Help' => 'babelfish', 'Module' => 'babelfish') ); -&addCmdHook('(botmail|message)', ('CODEREF' => 'botmail::parse', 'Identifier' => 'botmail', 'Cmdstats' => 'botmail') ); -&addCmdHook('bzflist17', ('CODEREF' => 'BZFlag::list17', 'Identifier' => 'BZFlag', 'Cmdstats' => 'BZFlag', 'Forker' => 1, 'Module' => 'BZFlag') ); -&addCmdHook('bzflist', ('CODEREF' => 'BZFlag::list', 'Identifier' => 'BZFlag', 'Cmdstats' => 'BZFlag', 'Forker' => 1, 'Module' => 'BZFlag') ); -&addCmdHook('bzfquery', ('CODEREF' => 'BZFlag::query', 'Identifier' => 'BZFlag', 'Cmdstats' => 'BZFlag', 'Forker' => 1, 'Module' => 'BZFlag') ); -&addCmdHook('chan(stats|info)', ('CODEREF' => 'chaninfo', ) ); -&addCmdHook('cmd(stats|info)', ('CODEREF' => 'cmdstats', ) ); -&addCmdHook('convert', ('CODEREF' => 'convert', 'Forker' => 1, 'Identifier' => 'Units', 'Help' => 'convert') ); -&addCmdHook('(cookie|random)', ('CODEREF' => 'cookie', 'Forker' => 1, 'Identifier' => 'Factoids') ); -&addCmdHook('countdown', ('CODEREF' => 'countdown', 'Module' => 'countdown', 'Identifier' => 'countdown', 'Cmdstats' => 'countdown') ); -&addCmdHook('countrystats', ('CODEREF' => 'countryStats') ); -&addCmdHook('dauthor', ('CODEREF' => 'Debian::searchAuthor', 'Forker' => 1, 'Identifier' => 'Debian', 'Cmdstats' => 'Debian Author Search', 'Help' => 'dauthor' ) ); -&addCmdHook('d?bugs', ('CODEREF' => 'DebianExtra::Parse', 'Forker' => 1, 'Identifier' => 'DebianExtra', 'Cmdstats' => 'Debian Bugs') ); -&addCmdHook('d?contents', ('CODEREF' => 'Debian::searchContents', 'Forker' => 1, 'Identifier' => 'Debian', 'Cmdstats' => 'Debian Contents Search', 'Help' => 'contents' ) ); -&addCmdHook('d?find', ('CODEREF' => 'Debian::DebianFind', 'Forker' => 1, 'Identifier' => 'Debian', 'Cmdstats' => 'Debian Search', 'Help' => 'find' ) ); -&addCmdHook('dice', ('CODEREF' => 'dice::dice', 'Identifier' => 'dice', 'Cmdstats' => 'dice', 'Forker' => 1, 'Module' => 'dice') ); -&addCmdHook('Dict', ('CODEREF' => 'Dict::Dict', 'Identifier' => 'Dict', 'Help' => 'dict', 'Forker' => 1, 'Cmdstats' => 'Dict') ); -&addCmdHook('dincoming', ('CODEREF' => 'Debian::generateIncoming', 'Forker' => 1, 'Identifier' => 'Debian' ) ); -&addCmdHook('dnew', ('CODEREF' => 'DebianNew', 'Identifier' => 'Debian' ) ); -&addCmdHook('dns|d?nslookup', ('CODEREF' => 'dns::query', 'Identifier' => 'dns', 'Cmdstats' => 'dns', 'Forker' => 1, 'Help' => 'dns') ); -&addCmdHook('(d|search)desc', ('CODEREF' => 'Debian::searchDescFE', 'Forker' => 1, 'Identifier' => 'Debian', 'Cmdstats' => 'Debian Desc Search', 'Help' => 'ddesc' ) ); -&addCmdHook('dstats', ('CODEREF' => 'Debian::infoStats', 'Forker' => 1, 'Identifier' => 'Debian', 'Cmdstats' => 'Debian Statistics' ) ); -&addCmdHook('(ex)?change', ('CODEREF' => 'Exchange::query', 'Identifier' => 'Exchange', 'Cmdstats' => 'Exchange', 'Forker' => 1) ); -&addCmdHook('factinfo', ('CODEREF' => 'factinfo', 'Cmdstats' => 'Factoid Info', Module => 'Factoids', ) ); -&addCmdHook('factstats?', ('CODEREF' => 'factstats', 'Cmdstats' => 'Factoid Stats', Help => 'factstats', Forker => 1, 'Identifier' => 'Factoids', ) ); -&addCmdHook('help', ('CODEREF' => 'help', 'Cmdstats' => 'Help', ) ); -&addCmdHook('HTTPDtype', ('CODEREF' => 'HTTPDtype::HTTPDtype', 'Identifier' => 'HTTPDtype', 'Cmdstats' => 'HTTPDtype', 'Forker' => 1) ); -&addCmdHook('[ia]?spell', ('CODEREF' => 'spell::query', 'Identifier' => 'spell', 'Cmdstats' => 'spell', 'Forker' => 1, 'Help' => 'spell') ); -&addCmdHook('insult', ('CODEREF' => 'Insult::Insult', 'Forker' => 1, 'Identifier' => 'insult', 'Help' => 'insult' ) ); -&addCmdHook('karma', ('CODEREF' => 'karma', ) ); -&addCmdHook('kernel', ('CODEREF' => 'Kernel::Kernel', 'Forker' => 1, 'Identifier' => 'Kernel', 'Cmdstats' => 'Kernel', 'NoArgs' => 1) ); -&addCmdHook('lart', ('CODEREF' => 'lart', 'Identifier' => 'lart', 'Help' => 'lart') ); -&addCmdHook('lc', ('CODEREF' => 'case::lower', 'Identifier' => 'case', 'Cmdstats' => 'case', 'Forker' => 1, 'Module' => 'case') ); -&addCmdHook('listauth', ('CODEREF' => 'CmdListAuth', 'Identifier' => 'Search', Module => 'Factoids', 'Help' => 'listauth') ); -&addCmdHook('md5(sum)?', ('CODEREF' => 'md5::md5', 'Identifier' => 'md5', 'Cmdstats' => 'md5', 'Forker' => 1, 'Module' => 'md5') ); -&addCmdHook('metar', ('CODEREF' => 'Weather::Metar', 'Identifier' => 'Weather', 'Help' => 'weather', 'Cmdstats' => 'Weather', 'Forker' => 1) ); -&addCmdHook('News', ('CODEREF' => 'News::Parse', Module => 'News', 'Cmdstats' => 'News' ) ); -&addCmdHook('(?:nick|lame)ometer(?: for)?', ('CODEREF' => 'nickometer::query', 'Identifier' => 'nickometer', 'Cmdstats' => 'nickometer', 'Forker' => 1) ); -&addCmdHook('nullski', ('CODEREF' => 'nullski', ) ); -&addCmdHook('page', ('CODEREF' => 'pager::page', 'Identifier' => 'pager', 'Cmdstats' => 'pager', 'Forker' => 1, 'Help' => 'page') ); -&addCmdHook('piglatin', ('CODEREF' => 'piglatin::piglatin', 'Identifier' => 'piglatin', 'Cmdstats' => 'piglatin', 'Forker' => 1) ); -&addCmdHook('Plug', ('CODEREF' => 'Plug::Plug', 'Identifier' => 'Plug', 'Forker' => 1, 'Cmdstats' => 'Plug') ); -&addCmdHook('quote', ('CODEREF' => 'Quote::Quote', 'Forker' => 1, 'Identifier' => 'Quote', 'Help' => 'quote', 'Cmdstats' => 'Quote') ); -&addCmdHook('reverse', ('CODEREF' => 'reverse::reverse', 'Identifier' => 'reverse', 'Cmdstats' => 'reverse', 'Forker' => 1, 'Module' => 'reverse') ); -&addCmdHook('RootWarn', ('CODEREF' => 'CmdrootWarn', 'Identifier' => 'RootWarn', 'Module' => 'RootWarn') ); -&addCmdHook('OnJoin', ('CODEREF' => 'Cmdonjoin', 'Identifier' => 'OnJoin', 'Module' => 'OnJoin') ); -&addCmdHook('Rss', ('CODEREF' => 'Rss::Rss', 'Identifier' => 'Rss', 'Cmdstats' => 'Rss', 'Forker' => 1, 'Help' => 'rss') ); -&addCmdHook('sched(stats|info)', ('CODEREF' => 'scheduleList', ) ); -&addCmdHook('scramble', ('CODEREF' => 'scramble::scramble', 'Identifier' => 'scramble', 'Cmdstats' => 'scramble', 'Forker' => 1, 'Module' => 'scramble') ); -&addCmdHook('seen', ('CODEREF' => 'seen', 'Identifier' => 'seen') ); -&addCmdHook('slashdot', ('CODEREF' => 'Slashdot::Slashdot', 'Identifier' => 'slashdot', 'Forker' => 1, 'Cmdstats' => 'slashdot') ); -&addCmdHook('tell|explain', ('CODEREF' => 'tell', Help => 'tell', Identifier => 'allowTelling', Cmdstats => 'Tell') ); -&addCmdHook('uc', ('CODEREF' => 'case::upper', 'Identifier' => 'case', 'Cmdstats' => 'case', 'Forker' => 1, 'Module' => 'case') ); -&addCmdHook('Uptime', ('CODEREF' => 'uptime', 'Identifier' => 'Uptime', 'Cmdstats' => 'Uptime') ); -&addCmdHook('u(ser)?info', ('CODEREF' => 'userinfo', 'Identifier' => 'UserInfo', 'Help' => 'userinfo', 'Module' => 'UserInfo') ); -&addCmdHook('verstats', ('CODEREF' => 'do_verstats' ) ); -&addCmdHook('Weather', ('CODEREF' => 'Weather::Weather', 'Identifier' => 'Weather', 'Help' => 'weather', 'Cmdstats' => 'Weather', 'Forker' => 1, 'Module' => 'Weather') ); -&addCmdHook('wiki(pedia)?', ('CODEREF' => 'wikipedia::wikipedia', 'Identifier' => 'wikipedia', 'Cmdstats' => 'wikipedia', 'Forker' => 1, 'Help' => 'wikipedia', 'Module' => 'wikipedia') ); -&addCmdHook('wtf', ('CODEREF' => 'wtf::query', 'Identifier' => 'wtf', 'Cmdstats' => 'wtf', 'Forker' => 1, 'Help' => 'wtf', 'Module' => 'wtf') ); -&addCmdHook('zfi', ('CODEREF' => 'zfi::query', 'Identifier' => 'zfi', 'Cmdstats' => 'zfi', 'Forker' => 1, 'Module' => 'zfi') ); -&addCmdHook('(zippy|yow)', ('CODEREF' => 'zippy::get', 'Identifier' => 'Zippy', 'Cmdstats' => 'Zippy', 'Forker' => 1, 'Module' => 'Zippy') ); -&addCmdHook('zsi', ('CODEREF' => 'zsi::query', 'Identifier' => 'zsi', 'Cmdstats' => 'zsi', 'Forker' => 1, 'Module' => 'zsi') ); -### -### END OF ADDING HOOKS. -### - -&status('loaded '.scalar(keys %cmdhooks).' command hooks.'); - -1; diff --git a/blootbot/src/DynaConfig.pl b/blootbot/src/DynaConfig.pl deleted file mode 100644 index 85168e0..0000000 --- a/blootbot/src/DynaConfig.pl +++ /dev/null @@ -1,844 +0,0 @@ -# -# DynaConfig.pl: Read/Write configuration files dynamically. -# Author: dms -# Version: v0.1 (20010120) -# Created: 20010119 -# NOTE: Merged from User.pl -# - -use strict; - -use vars qw(%chanconf %cache %bans %channels %nuh %users %ignore - %talkWho %dcc %mask); -use vars qw($utime_userfile $ucount_userfile $utime_chanfile $who - $ucount_chanfile $userHandle $chan $msgType $talkchannel - $ident $bot_state_dir $talkWho $flag_quit $wtime_userfile - $wcount_userfile $wtime_chanfile $nuh $message); - -##### -##### USERFILE CONFIGURATION READER/WRITER -##### - -sub readUserFile { - my $f = "$bot_state_dir/blootbot.users"; - - if (! -f $f) { - &DEBUG("userfile not found; new fresh run detected."); - return; - } - - if ( -f $f and -f "$f~") { - my $s1 = -s $f; - my $s2 = -s "$f~"; - - if ($s2 > $s1*3) { - &FIXME("rUF: backup file bigger than current file."); - } - } - - if (!open IN, $f) { - &ERROR("Cannot read userfile ($f): $!"); - &closeLog(); - exit 1; - } - - undef %users; # clear on reload. - undef %bans; # reset. - undef %ignore; # reset. - - my $ver = ; - if ($ver !~ /^#v1/) { - &ERROR("old or invalid user file found."); - &closeLog(); - exit 1; # correct? - } - - my $nick; - my $type; - while () { - chop; - - next if /^$/; - next if /^#/; - - if (/^--(\S+)[\s\t]+(.*)$/) { # user: middle entry. - my ($what,$val) = ($1,$2); - - if (!defined $val or $val eq '') { - &WARN("$what: val == NULL."); - next; - } - - if (!defined $nick) { - &WARN("DynaConfig: invalid line: $_"); - next; - } - - # nice little hack. - if ($what eq 'HOSTS') { - $users{$nick}{$what}{$val} = 1; - } else { - $users{$nick}{$what} = $val; - } - - } elsif (/^(\S+)$/) { # user: start entry. - $nick = $1; - - } elsif (/^::(\S+) ignore$/) { # ignore: start entry. - $chan = $1; - $type = 'ignore'; - - } elsif (/^- (\S+):\+(\d+):\+(\d+):(\S+):(.*)$/ and $type eq 'ignore') { - ### ignore: middle entry. - my $mask = $1; - my(@array) = ($2,$3,$4,$5); - ### DEBUG purposes only! - if ($mask !~ /^$mask{nuh}$/) { - &WARN("ignore: mask $mask is invalid."); - next; - } - $ignore{$chan}{$mask} = \@array; - - } elsif (/^::(\S+) bans$/) { # bans: start entry. - $chan = $1; - $type = 'bans'; - - } elsif (/^- (\S+):\+(\d+):\+(\d+):(\d+):(\S+):(.*)$/ and $type eq 'bans') { - ### bans: middle entry. - # $btime, $atime, $count, $whoby, $reason. - my(@array) = ($2,$3,$4,$5,$6); - $bans{$chan}{$1} = \@array; - - } else { # unknown. - &WARN("unknown line: $_"); - } - } - close IN; - - &status( sprintf("USERFILE: Loaded: %d users, %d bans, %d ignore", - scalar(keys %users)-1, - scalar(keys %bans), # ?? - scalar(keys %ignore), # ?? - ) - ); -} - -sub writeUserFile { - if (!scalar keys %users) { - &DEBUG("wUF: nothing to write."); - return; - } - - if (!open OUT,">$bot_state_dir/blootbot.users") { - &ERROR("Cannot write userfile ($bot_state_dir/blootbot.users): $!"); - return; - } - - my $time = scalar(gmtime); - - print OUT "#v1: blootbot -- $ident -- written $time\n\n"; - - ### USER LIST. - my $cusers = 0; - foreach (sort keys %users) { - my $user = $_; - $cusers++; - my $count = scalar keys %{ $users{$user} }; - if (!$count) { - &WARN("user $user has no other attributes; skipping."); - next; - } - - print OUT "$user\n"; - - foreach (sort keys %{ $users{$user} }) { - my $what = $_; - my $val = $users{$user}{$_}; - - if (ref($val) eq 'HASH') { - foreach (sort keys %{ $users{$user}{$_} }) { - print OUT "--$what\t\t$_\n"; - } - - } elsif ($_ eq 'FLAGS') { - print OUT "--$_\t\t" . join('', sort split('', $val)) . "\n"; - } else { - print OUT "--$_\t\t$val\n"; - } - } - print OUT "\n"; - } - - ### BAN LIST. - my $cbans = 0; - foreach (keys %bans) { - my $chan = $_; - $cbans++; - - my $count = scalar keys %{ $bans{$chan} }; - if (!$count) { - &WARN("bans: chan $chan has no other attributes; skipping."); - next; - } - - print OUT "::$chan bans\n"; - foreach (keys %{ $bans{$chan} }) { -# format: bans: mask expire time-added count who-added reason - my @array = @{ $bans{$chan}{$_} }; - if (scalar @array != 5) { - &WARN("bans: $chan/$_ is corrupted."); - next; - } - - printf OUT "- %s:+%d:+%d:%d:%s:%s\n", $_, @array; - } - } - print OUT "\n" if ($cbans); - - ### IGNORE LIST. - my $cignore = 0; - foreach (keys %ignore) { - my $chan = $_; - $cignore++; - - my $count = scalar keys %{ $ignore{$chan} }; - if (!$count) { - &WARN("ignore: chan $chan has no other attributes; skipping."); - next; - } - - ### TODO: use hash instead of array for flexibility? - print OUT "::$chan ignore\n"; - foreach (keys %{ $ignore{$chan} }) { -# format: ignore: mask expire time-added who-added reason - my @array = @{ $ignore{$chan}{$_} }; - if (scalar @array != 4) { - &WARN("ignore: $chan/$_ is corrupted."); - next; - } - - printf OUT "- %s:+%d:+%d:%s:%s\n", $_, @array; - } - } - - close OUT; - - $wtime_userfile = time(); - &status("--- Saved USERFILE ($cusers users; $cbans bans; $cignore ignore) at $time"); - if (defined $msgType and $msgType =~ /^chat$/) { - &performStrictReply("--- Writing user file..."); - } -} - -##### -##### CHANNEL CONFIGURATION READER/WRITER -##### - -sub readChanFile { - my $f = "$bot_state_dir/blootbot.chan"; - if ( -f $f and -f "$f~") { - my $s1 = -s $f; - my $s2 = -s "$f~"; - - if ($s2 > $s1*3) { - &FIXME("rCF: backup file bigger than current file."); - } - } - - if (!open IN, $f) { - &ERROR("Cannot read chanfile ($f): $!"); - return; - } - - undef %chanconf; # reset. - - $_ = ; # version string. - - my $chan; - while () { - chop; - - next if /^\s*$/; - next if /^\// or /^\;/; # / or ; are comment lines. - - if (/^(\S+)\s*$/) { - $chan = $1; - next; - } - next unless (defined $chan); - - if (/^[\s\t]+\+(\S+)$/) { # bool, true. - $chanconf{$chan}{$1} = 1; - - } elsif (/^[\s\t]+\-(\S+)$/) { # bool, false. - # although this is supported in run-time configuration. - $chanconf{$chan}{$1} = 0; - - } elsif (/^[\s\t]+(\S+)[\s\t]+(.*)$/) {# what = val. - $chanconf{$chan}{$1} = $2; - - } else { - &WARN("unknown line: $_") unless (/^#/); - } - } - close IN; - - # verify configuration - ### TODO: check against valid params. - foreach $chan (keys %chanconf) { - foreach (keys %{ $chanconf{$chan} }) { - next unless /^[+-]/; - - &WARN("invalid param: chanconf{$chan}{$_}; removing."); - delete $chanconf{$chan}{$_}; - undef $chanconf{$chan}{$_}; - } - } - - &status("CHANFILE: Loaded: ".(scalar(keys %chanconf)-1)." chans"); -} - -sub writeChanFile { - if (!scalar keys %chanconf) { - &DEBUG("wCF: nothing to write."); - return; - } - - if (!open OUT,">$bot_state_dir/blootbot.chan") { - &ERROR("Cannot write chanfile ($bot_state_dir/blootbot.chan): $!"); - return; - } - - my $time = scalar(gmtime); - print OUT "#v1: blootbot -- $ident -- written $time\n\n"; - - if ($flag_quit) { - - ### Process 1: if defined in _default, remove same definition - ### from non-default channels. - foreach (keys %{ $chanconf{_default} }) { - my $opt = $_; - my $val = $chanconf{_default}{$opt}; - my @chans; - - foreach (keys %chanconf) { - $chan = $_; - - next if ($chan eq "_default"); - next unless (exists $chanconf{$chan}{$opt}); - next unless ($val eq $chanconf{$chan}{$opt}); - - push(@chans,$chan); - delete $chanconf{$chan}{$opt}; - } - - if (scalar @chans) { - &DEBUG("Removed config $opt to @chans since it's defiend in '_default'"); - } - } - - ### Process 2: if defined in all chans but _default, set in - ### _default and remove all others. - my (%optsval, %opts); - foreach (keys %chanconf) { - $chan = $_; - next if ($chan eq "_default"); - my $opt; - - foreach (keys %{ $chanconf{$chan} }) { - $opt = $_; - if (exists $optsval{$opt} and $optsval{$opt} eq $chanconf{$chan}{$opt}) { - $opts{$opt}++; - next; - } - $optsval{$opt} = $chanconf{$chan}{$opt}; - $opts{$opt} = 1; - } - } - - foreach (keys %opts) { - next unless ($opts{$_} > 2); - &DEBUG(" opts{$_} => $opts{$_}"); - } - - ### other optimizations are in UserDCC.pl - } - - ### lets do it... - foreach (sort keys %chanconf) { - $chan = $_; - - print OUT "$chan\n"; - - foreach (sort keys %{ $chanconf{$chan} }) { - my $val = $chanconf{$chan}{$_}; - - if ($val =~ /^0$/) { # bool, false. - print OUT " -$_\n"; - - } elsif ($val =~ /^1$/) { # bool, true. - print OUT " +$_\n"; - - } else { # what = val. - print OUT " $_ $val\n"; - - } - - } - print OUT "\n"; - } - - close OUT; - - $wtime_chanfile = time(); - &status("--- Saved CHANFILE (".scalar(keys %chanconf). - " chans) at $time"); - - if (defined $msgType and $msgType =~ /^chat$/) { - &performStrictReply("--- Writing chan file..."); - } -} - -##### -##### USER COMMANDS. -##### - -# TODO: support multiple flags. -# TODO: return all flags for opers -sub IsFlag { - my $flags = shift; - my ($ret, $f, $o) = ''; - - &verifyUser($who, $nuh); - - foreach $f (split //, $users{$userHandle}{FLAGS}) { - foreach $o ( split //, $flags ) { - next unless ($f eq $o); - - $ret = $f; - last; - } - } - - $ret; -} - -sub verifyUser { - my ($nick, $lnuh) = @_; - my ($user, $m); - - if ($userHandle = $dcc{'CHATvrfy'}{$who}) { - &VERB("vUser: cached auth for $who.",2); - return $userHandle; - } - - $userHandle = ''; - - foreach $user (keys %users) { - next if ($user eq "_default"); - - foreach $m (keys %{ $users{$user}{HOSTS} }) { - $m =~ s/\?/./g; - $m =~ s/\*/.*?/g; - $m =~ s/([\@\(\)\[\]])/\\$1/g; - - next unless ($lnuh =~ /^$m$/i); - - if ($user !~ /^\Q$nick\E$/i and !exists $cache{VUSERWARN}{$user}) { - &status("vU: host matched but diff nick ($nick != $user)."); - $cache{VUSERWARN}{$user} = 1; - } - - $userHandle = $user; - last; - } - - last if ($userHandle ne ''); - - if ($user =~ /^\Q$nick\E$/i and !exists $cache{VUSERWARN}{$user}) { - &status("vU: nick matched but host is not in list ($lnuh)."); - $cache{VUSERWARN}{$user} = 1; - } - } - - $userHandle ||= "_default"; - # what's talkchannel for? - $talkWho{$talkchannel} = $who if (defined $talkchannel); - $talkWho = $who; - - return $userHandle; -} - -sub ckpasswd { - # returns true if arg1 encrypts to arg2 - my ($plain, $encrypted) = @_; - if ($encrypted eq '') { - ($plain, $encrypted) = split(/\s+/, $plain, 2); - } - return 0 unless ($plain ne '' and $encrypted ne ''); - - # MD5 // DES. Bobby Billingsley++. - my $salt; - if ($encrypted =~ /^(\S{2})/ and length $encrypted == 13) { - $salt = $1; - } elsif ($encrypted =~ /^\$\d\$(\w\w)\$/) { - $salt = $1; - } else { - &DEBUG("unknown salt from $encrypted."); - return 0; - } - - return ($encrypted eq crypt($plain, $salt)); -} - -# mainly for dcc chat... hrm. -sub hasFlag { - my ($flag) = @_; - - if (&IsFlag($flag) eq $flag) { - return 1; - } else { - &status("DCC CHAT: <$who> $message -- not enough flags."); - &performStrictReply("error: you do not have enough flags for that. ($flag required)"); - return 0; - } -} - -# expire is time in minutes -sub ignoreAdd { - my($mask,$chan,$expire,$comment) = @_; - - $chan ||= '*'; # global if undefined. - $comment ||= ''; # optional. - $expire ||= 0; # permament. - my $count ||= 0; - - if ($expire > 0) { - $expire = ($expire*60) + time(); - } else { - $expire = 0; - } - - my $exist = 0; - $exist++ if (exists $ignore{$chan}{$mask}); - - $ignore{$chan}{$mask} = [$expire, time(), $who, $comment]; - - # TODO: improve this. - if ($expire == 0) { - &status("ignore: Added $mask for $chan to NEVER expire, by $who, for $comment"); - } else { - &status("ignore: Added $mask for $chan to expire $expire mins, by $who, for $comment"); - } - - if ($exist) { - $utime_userfile = time(); - $ucount_userfile++; - - return 2; - } else { - return 1; - } -} - -sub ignoreDel { - my($mask) = @_; - my @match; - - ### TODO: support wildcards. - foreach (keys %ignore) { - my $chan = $_; - - foreach (grep /^\Q$mask\E$/i, keys %{ $ignore{$chan} }) { - delete $ignore{$chan}{$mask}; - push(@match,$chan); - } - - &DEBUG("iD: scalar => ".scalar(keys %{ $ignore{$chan} }) ); - } - - if (scalar @match) { - $utime_userfile = time(); - $ucount_userfile++; - } - - return @match; -} - -sub userAdd { - my($nick,$mask) = @_; - - if (exists $users{$nick}) { - return 0; - } - - $utime_userfile = time(); - $ucount_userfile++; - - if (defined $mask and $mask !~ /^\s*$/) { - &DEBUG("userAdd: mask => $mask"); - $users{$nick}{HOSTS}{$mask} = 1; - } - - $users{$nick}{FLAGS} ||= $users{_default}{FLAGS}; - - return 1; -} - -sub userDel { - my($nick) = @_; - - if (!exists $users{$nick}) { - return 0; - } - - $utime_userfile = time(); - $ucount_userfile++; - - delete $users{$nick}; - - return 1; -} - -sub banAdd { - my($mask,$chan,$expire,$reason) = @_; - - $chan ||= '*'; - $expire ||= 0; - - if ($expire > 0) { - $expire = $expire*60 + time(); - } - - my $exist = 1; - $exist++ if (exists $bans{$chan}{$mask} or - exists $bans{'*'}{$mask}); - $bans{$chan}{$mask} = [$expire, time(), 0, $who, $reason]; - - my @chans = ($chan eq '*') ? keys %channels : $chan; - my $m = $mask; - $m =~ s/\?/\\./g; - $m =~ s/\*/\\S*/g; - foreach (@chans) { - my $chan = $_; - foreach (keys %{ $channels{$chan}{''} }) { - next unless (exists $nuh{lc $_}); - next unless ($nuh{lc $_} =~ /^$m$/i); - &FIXME("nuh{$_} =~ /$m/"); - } - } - - if ($exist == 1) { - $utime_userfile = time(); - $ucount_userfile++; - } - - return $exist; -} - -sub banDel { - my($mask) = @_; - my @match; - - foreach (keys %bans) { - my $chan = $_; - - foreach (grep /^\Q$mask\E$/i, keys %{ $bans{$chan} }) { - delete $bans{$chan}{$_}; - push(@match, $chan); - } - - &DEBUG("bans: scalar => ".scalar(keys %{ $bans{$chan} }) ); - } - - if (scalar @match) { - $utime_userfile = time(); - $ucount_userfile++; - } - - return @match; -} - -sub IsUser { - my($user) = @_; - - if ( &getUser($user) ) { - return 1; - } else { - return 0; - } -} - -sub getUser { - my($user) = @_; - - if (!defined $user) { - &WARN("getUser: user == NULL."); - return; - } - - if (my @retval = grep /^\Q$user\E$/i, keys %users) { - if ($retval[0] ne $user) { - &WARN("getUser: retval[0] ne user ($retval[0] ne $user)"); - } - my $count = scalar keys %{ $users{$retval[0]} }; - &DEBUG("count => $count."); - - return $retval[0]; - } else { - return; - } -} - -sub chanSet { - my($cmd, $chan, $what, $val) = @_; - - if ($cmd eq "+chan") { - if (exists $chanconf{$chan}) { - &performStrictReply("chan $chan already exists."); - return; - } - $chanconf{$chan}{_time_added} = time(); - $chanconf{$chan}{autojoin} = $conn->nick(); - - &performStrictReply("Joining $chan..."); - &joinchan($chan); - - return; - } - - if (!exists $chanconf{$chan}) { - &performStrictReply("no such channel $chan"); - return; - } - - my $update = 0; - - if (defined $what and $what =~ s/^([+-])(\S+)/$2/) { - ### ".chanset +blah" - ### ".chanset +blah 10" -- error. - - my $set = ($1 eq "+") ? 1 : 0; - my $was = $chanconf{$chan}{$what}; - - if ($set) { # add/set. - if (defined $was and $was eq '1') { - &performStrictReply("setting $what for $chan already 1."); - return; - } - - $val = 1; - - } else { # delete/unset. - if (!defined $was) { - &performStrictReply("setting $what for $chan is not set."); - return; - } - - $val = 0; - } - - # alter for cosmetic (print out) reasons only. - $was = (defined $was) ? "; was '$was'" : ''; - - if ($val eq '0') { - &performStrictReply("Unsetting $what for $chan$was."); - delete $chanconf{$chan}{$what}; - } else { - &performStrictReply("Setting $what for $chan to '$val'$was."); - $chanconf{$chan}{$what} = $val; - } - - $update++; - - } elsif (defined $val) { - ### ".chanset blah testing" - - my $was = $chanconf{$chan}{$what}; - if (defined $was and $was eq $val) { - &performStrictReply("setting $what for $chan already '$val'."); - return; - } - $was = ($was) ? "; was '$was'" : ''; - &performStrictReply("Setting $what for $chan to '$val'$was."); - - $chanconf{$chan}{$what} = $val; - - $update++; - - } else { # read only. - ### ".chanset" - ### ".chanset blah" - - if (!defined $what) { - &WARN("chanset/DC: what == undefine."); - return; - } - - if (exists $chanconf{$chan}{$what}) { - &performStrictReply("$what for $chan is '$chanconf{$chan}{$what}'"); - } else { - &performStrictReply("$what for $chan is not set."); - } - } - - if ($update) { - $utime_chanfile = time(); - $ucount_chanfile++; - } - - return; -} - -sub rehashConfVars { - # this is an attempt to fix where an option is enabled but the module - # has been not loaded. it also can be used for other things. - - foreach (keys %{ $cache{confvars} }) { - my $i = $cache{confvars}{$_}; - &DEBUG("rehashConfVars: _ => $_"); - - if (/^news$/ and $i) { - &loadMyModule('News'); - delete $cache{confvars}{$_}; - } - - if (/^uptime$/ and $i) { - &loadMyModule('Uptime'); - delete $cache{confvars}{$_}; - } - - if (/^rootwarn$/i and $i) { - &loadMyModule('RootWarn'); - delete $cache{confvars}{$_}; - } - - if (/^onjoin$/i and $i) { - &loadMyModule('OnJoin'); - delete $cache{confvars}{$_}; - } - } - - &DEBUG("end of rehashConfVars"); - - delete $cache{confvars}; -} - -my @regFlagsUser = ( - # possible chars to include in FLAG - 'A', # bot administration over /msg - # default is only via DCC CHAT - 'O', # dynamic ops (as on channel). (automatic +o) - 'T', # add topics. - 'a', # ask/request factoid. - 'm', # modify factoid. (includes renaming) - 'n', # bot owner, can 'reload' - 'o', # master of bot (automatic +amrt) - # can search on factoid strings shorter than 2 chars - # can tell bot to join new channels - # can [un]lock factoids - 'r', # remove factoid. - 't', # teach/add factoid. -); - -1; diff --git a/blootbot/src/Factoids/Core.pl b/blootbot/src/Factoids/Core.pl deleted file mode 100644 index a43a3d6..0000000 --- a/blootbot/src/Factoids/Core.pl +++ /dev/null @@ -1,542 +0,0 @@ -# -# Misc.pl: Miscellaneous stuff. -# Author: dms -# Version: v0.1 (20010906) -# Created: 20010906 -# - -# use strict; # TODO - -use vars qw(%param %cache %lang %cmdstats %bots); -use vars qw($message $who $addressed $chan $h $nuh $ident $msgType - $correction_plausable); - -# Usage: &validFactoid($lhs,$rhs); -sub validFactoid { - my ($lhs,$rhs) = @_; - my $valid = 0; - - for (lc $lhs) { - # allow the following only if they have been made on purpose. - if ($rhs ne '' and $rhs !~ /^/ and last; # '=>'. - /\;\;/ and last; # ';;'. - /\|\|/ and last; # '||'. - - /^\Q$ident\E[\'\,\: ]/ and last;# dupe addressed. - /^[\-\, ]/ and last; - /\\$/ and last; # forgot shift for '?'. - /^all / and last; - /^also / and last; - / also$/ and last; - / and$/ and last; - /^because / and last; - /^but / and last; - /^gives / and last; - /^h(is|er) / and last; - /^if / and last; - / is,/ and last; - / it$/ and last; - /^or / and last; - / says$/ and last; - /^should / and last; - /^so / and last; - /^supposedly/ and last; - /^to / and last; - /^was / and last; - / which$/ and last; - - # nasty bug I introduced _somehow_, probably by fixMySQLBug(). - /\\\%/ and last; - /\\\_/ and last; - - # weird/special stuff. also old blootbot or stock infobot bugs. - $rhs =~ /( \Q$ident\E's|\Q$ident\E's )/i and last; # ownership. - - # duplication. - $rhs =~ /^\Q$lhs /i and last; - last if ($rhs =~ /^is /i and / is$/); - - $valid++; - } - - return $valid; -} - -sub FactoidStuff { - # inter-infobot. - if ($msgType =~ /private/ and $message =~ s/^:INFOBOT://) { - ### identification. - &status("infobot <$nuh> identified") unless $bots{$nuh}; - $bots{$nuh} = $who; - - ### communication. - - # query. - if ($message =~ /^QUERY (<.*?>) (.*)/) { # query. - my ($target,$item) = ($1,$2); - $item =~ s/[.\?]$//; - - &status(":INFOBOT:QUERY $who: $message"); - - if ($_ = &getFactoid($item)) { - &msg($who, ":INFOBOT:REPLY $target $item =is=> $_"); - } - - return 'INFOBOT QUERY'; - } elsif ($message =~ /^REPLY <(.*?)> (.*)/) { # reply. - my ($target,$item) = ($1,$2); - - &status(":INFOBOT:REPLY $who: $message"); - - my ($lhs,$mhs,$rhs) = $item =~ /^(.*?) =(.*?)=> (.*)/; - - if ($param{'acceptUrl'} !~ /REQUIRE/ or $rhs =~ /(http|ftp|mailto|telnet|file):/) { - &msg($target, "$who knew: $lhs $mhs $rhs"); - - # 'are' hack :) - $rhs = " are" if ($mhs eq 'are'); - &setFactInfo($lhs, 'factoid_value', $rhs); - } - - return 'INFOBOT REPLY'; - } else { - &ERROR(":INFOBOT:UNKNOWN $who: $message"); - return 'INFOBOT UNKNOWN'; - } - } - - # factoid forget. - if ($message =~ s/^forget\s+//i) { - return 'forget: no addr' unless ($addressed); - - my $faqtoid = $message; - if ($faqtoid eq '') { - &help('forget'); - return; - } - - $faqtoid =~ tr/A-Z/a-z/; - my $result = &getFactoid($faqtoid); - - # if it doesn't exist, well... it doesn't! - if (!defined $result) { - &performReply("i didn't have anything called '$faqtoid' to forget"); - return; - } - - # TODO: squeeze 3 getFactInfo calls into one? - my $author = &getFactInfo($faqtoid, 'created_by'); - my $count = &getFactInfo($faqtoid, 'requested_count') || 0; - # don't delete if requested $limit times - my $limit = &getChanConfDefault('factoidPreventForgetLimit', 100, $chan); - # don't delete if older than $limitage seconds (modified by requests below) - my $limitage = &getChanConfDefault('factoidPreventForgetLimitTime', 7 * 24 * 60 * 60, $chan); - my $t = &getFactInfo($faqtoid, 'created_time') || 0; - my $age = time() - $t; - - # lets scale limitage from 1 (nearly 0) to $limit (full time). - $limitage = $limitage*($count+1)/$limit if ($count < $limit); - # isauthor and isop. - my $isau = (defined $author and &IsHostMatch($author) == 2) ? 1 : 0; - my $isop = (&IsFlag('o') eq 'o') ? 1 : 0; - - if (IsFlag('r') ne 'r' && !$isop) { - &msg($who, "you don't have access to remove factoids"); - return; - } - - return 'locked factoid' if (&IsLocked($faqtoid) == 1); - - ### - ### lets go do some checking. - ### - - # factoidPreventForgetLimitTime: - if (!($isop or $isau) and $age/(60*60*24) > $limitage) { - &msg($who, "cannot remove factoid '$faqtoid', too old. (" . - $age/(60*60*24) . ">$limitage) use 'no,' instead"); - return; - } - - # factoidPreventForgetLimit: - if (!($isop or $isau) and $limit and $count > $limit) { - &msg($who, "will not delete '$faqtoid', count > limit ($count > $limit) use 'no, ' instead."); - return; - } - - # this may eat some memory. - # prevent deletion if other factoids redirect to it. - # TODO: use hash instead of array. - my @list; - if (&getChanConf('factoidPreventForgetRedirect')) { - &status("Factoids/Core: forget: checking for redirect factoids"); - @list = &searchTable('factoids', 'factoid_key', - 'factoid_value', "^ see "); - } - - my $match = 0; - for (@list) { - my $f = $_; - my $v = &getFactInfo($f, 'factoid_value'); - my $fsafe = quotemeta($faqtoid); - next unless ($v =~ /^ ?see( also)? $fsafe\.?$/i); - - &DEBUG("Factoids/Core: match! ($f || $faqtoid)"); - - $match++; - } - # TODO: warn for op aswell, but allow force delete. - if (!$isop and $match) { - &msg($who, "uhm, other (redirection) factoids depend on this one."); - return; - } - - # minimize abuse. - if (!$isop and &IsHostMatch($author) != 2) { - $cache{forget}{$h}++; - - # warn. - if ($cache{forget}{$h} > 3) { - &msg($who, "Stop abusing forget!"); - } - - # ignore. - # TODO: make forget limit configurable. - # TODO: make forget ignore time configurable. - if ($cache{forget}{$h} > 5) { - &ignoreAdd(&makeHostMask($nuh), '*', 3*24*60, "abuse of forget"); - &msg($who, "forget: Ignoring you for abuse!"); - } - } - - # lets do it! - - if (&IsParam('factoidDeleteDelay') or &IsChanConf('factoidDeleteDelay') > 0) { - if (!($isop or $isau) and $faqtoid =~ / #DEL#$/) { - &msg($who, "cannot delete it ($faqtoid)."); - return; - } - - &status("forgot (safe delete): '$faqtoid' - ". scalar(gmtime)); - ### TODO: check if the 'backup' exists and overwrite it - my $check = &getFactoid("$faqtoid #DEL#"); - - if (!defined $check or $check =~ /^\s*$/) { - if ($faqtoid !~ / #DEL#$/) { - my $new = $faqtoid." #DEL#"; - - my $backup = &getFactoid($new); - if ($backup) { - &DEBUG("forget: not overwriting backup: $faqtoid"); - } else { - &status("forget: backing up '$faqtoid'"); - &setFactInfo($faqtoid, 'factoid_key', $new); - &setFactInfo($new, 'modified_by', $who); - &setFactInfo($new, 'modified_time', time()); - } - - } else { - &status("forget: not backing up $faqtoid."); - } - - } else { - &status("forget: not overwriting backup!"); - } - } - - &status("forget: <$who> '$faqtoid' =is=> '$result'"); - &delFactoid($faqtoid); - - &performReply("i forgot $faqtoid"); - - $count{'Update'}++; - - return; - } - - # factoid unforget/undelete. - if ($message =~ s/^un(forget|delete)\s+//i) { - return 'unforget: no addr' unless ($addressed); - - my $i = 0; - $i++ if (&IsParam('factoidDeleteDelay')); - $i++ if (&IsChanConf('factoidDeleteDelay') > 0); - if (!$i) { - &performReply("safe delete has been disable so what is there to undelete?"); - return; - } - - my $faqtoid = $message; - if ($faqtoid eq '') { - &help('unforget'); - return; - } - - $faqtoid =~ tr/A-Z/a-z/; - my $result = &getFactoid($faqtoid." #DEL#"); - my $check = &getFactoid($faqtoid); - - if (defined $check) { - &performReply("cannot undeleted '$faqtoid' because it already exists!"); - return; - } - - if (!defined $result) { - &performReply("that factoid was not backedup :/"); - return; - } - - &setFactInfo($faqtoid." #DEL#", 'factoid_key', $faqtoid); -# &setFactInfo($faqtoid, 'modified_by', ''); -# &setFactInfo($faqtoid, 'modified_time', 0); - - $check = &getFactoid($faqtoid); - # TODO: check if $faqtoid." #DEL#" exists? - if (defined $check) { - &performReply("Successfully recovered '$faqtoid'. Have fun now."); - $count{'Undelete'}++; - } else { - &performReply("did not recover '$faqtoid'. What happened?"); - } - - return; - } - - # factoid locking. - if ($message =~ /^((un)?lock)(\s+(.*))?\s*?$/i) { - return 'lock: no addr 2' unless ($addressed); - - my $function = lc $1; - my $faqtoid = lc $4; - - if ($faqtoid eq '') { - &help($function); - return; - } - - if (&getFactoid($faqtoid) eq '') { - &msg($who, "factoid \002$faqtoid\002 does not exist"); - return; - } - - if ($function eq 'lock') { - # strongly requested by #debian on 19991028. -xk - if (1 and $faqtoid !~ /^\Q$who\E$/i and &IsFlag('o') ne 'o') { - &msg($who,"sorry, locking cannot be used since it can be abused unneccesarily."); - &status("Replace 1 with 0 in Process.pl#~324 for locking support."); - return; - } - - &CmdLock($faqtoid); - } else { - &CmdUnLock($faqtoid); - } - - return; - } - - # factoid rename. - if ($message =~ s/^rename(\s+|$)//) { - return 'rename: no addr' unless ($addressed); - - if ($message eq '') { - &help('rename'); - return; - } - - if ($message =~ /^'(.*)'\s+'(.*)'$/) { - my ($from,$to) = (lc $1, lc $2); - - my $result = &getFactoid($from); - if (!defined $result) { - &performReply("i didn't have anything called '$from' to rename"); - return; - } - - # who == nick!user@host. - if (&IsFlag('m') ne 'm' and $author !~ /^\Q$who\E\!/i) { - &msg($who, "factoid '$from' is not yours to modify."); - return; - } - - if ($_ = &getFactoid($to)) { - &performReply("destination factoid already exists."); - return; - } - - &setFactInfo($from,'factoid_key',$to); - - &status("rename: <$who> '$from' is now '$to'"); - &performReply("i renamed '$from' to '$to'"); - } else { - &msg($who,"error: wrong format. ask me about 'help rename'."); - } - - return; - } - - # factoid substitution. (X =~ s/A/B/FLAG) - if ($message =~ m|^(.*?)\s+=~\s+s([/,#])(.+?)\2(.*?)\2([a-z]*);?\s*$|) { - my ($faqtoid,$delim,$op,$np,$flags) = (lc $1, $2, $3, $4, $5); - return 'subst: no addr' unless ($addressed); - - # incorrect format. - if ($np =~ /$delim/) { - &msg($who,"looks like you used the delimiter too many times. You may want to use a different delimiter, like ':' or '#'."); - return; - } - - # success. - if (my $result = &getFactoid($faqtoid)) { - return 'subst: locked' if (&IsLocked($faqtoid) == 1); - my $was = $result; - - if (($flags eq 'g' && $result =~ s/\Q$op/$np/gi) || $result =~ s/\Q$op/$np/i) { - # excessive length. - if (length $result > $param{'maxDataSize'}) { - &performReply("that's too long"); - return; - } - # empty - if (length $result == 0) { - &performReply("factoid would be empty. use forget?"); - return; - } - # min length. - my $faqauth = &getFactInfo($faqtoid, 'created_by'); - if ((length $result)*2 < length $was and - &IsFlag('o') ne 'o' and - &IsHostMatch($faqauth) != 2 - ) { - &performReply("too drastic change of factoid."); - } - - &setFactInfo($faqtoid, 'factoid_value', $result); - &status("update: '$faqtoid' =is=> '$result'; was '$was'"); - &performReply('OK'); - } else { - &performReply("that doesn't contain '$op'"); - } - } else { - &performReply("i didn't have anything called '$faqtoid' to modify"); - } - - return; - } - - # Fix up $message for question. - my $question = $message; - for ($question) { - # fix the string. - s/^hey([, ]+)where/where/i; - s/\s+\?$/?/; - s/^whois /who is /i; # Must match ^, else factoids with "whois" anywhere break - s/where can i find/where is/i; - s/how about/where is/i; - s/ da / the /ig; - - # clear the string of useless words. - s/^(stupid )?q(uestion)?:\s+//i; - s/^(does )?(any|ne)(1|one|body) know //i; - - s/^[uh]+m*[,\.]* +//i; - - s/^well([, ]+)//i; - s/^still([, ]+)//i; - s/^(gee|boy|golly|gosh)([, ]+)//i; - s/^(well|and|but|or|yes)([, ]+)//i; - - s/^o+[hk]+(a+y+)?([,. ]+)//i; - s/^g(eez|osh|olly)([,. ]+)//i; - s/^w(ow|hee|o+ho+)([,. ]+)//i; - s/^heya?,?( folks)?([,. ]+)//i; - } - - if ($addressed and $message =~ s/^no([, ]+)(\Q$ident\E\,+)?\s*//i) { - $correction_plausible = 1; - &status("correction is plausible, initial negative and nick deleted ($&)") if ($param{VERBOSITY}); - } else { - $correction_plausible = 0; - } - - my $result = &doQuestion($question); - if (!defined $result or $result eq $noreply) { - return 'result from doQ undef.'; - } - - if (defined $result and $result !~ /^0?$/) { # question. - &status("question: <$who> $message"); - $count{'Question'}++; - } elsif (&IsChanConf('Math') > 0 and $addressed) { # perl math. - &loadMyModule('Math'); - my $newresult = &perlMath(); - - if (defined $newresult and $newresult ne '') { - $cmdstats{'Maths'}++; - $result = $newresult; - &status("math: <$who> $message => $result"); - } - } - - if ($result !~ /^0?$/) { - &performStrictReply($result); - return; - } - - # why would a friendly bot get passed here? - if (&IsParam('friendlyBots')) { - return if (grep lc($_) eq lc($who), split(/\s+/, $param{'friendlyBots'})); - } - - # do the statement. - if (!defined &doStatement($message)) { - return; - } - - return unless ($addressed and !$addrchar); - - if (length $message > 64) { - &status("unparseable-moron: $message"); -# &performReply( &getRandom(keys %{ $lang{'moron'} }) ); - $count{'Moron'}++; - - &performReply("You are moron \002#". $count{'Moron'} ."\002"); - return; - } - - &status("unparseable: $message"); - &performReply( &getRandom(keys %{ $lang{'dunno'} }) ); - $count{'Dunno'}++; -} - -1; diff --git a/blootbot/src/Factoids/DBCommon.pl b/blootbot/src/Factoids/DBCommon.pl deleted file mode 100644 index 1d7c499..0000000 --- a/blootbot/src/Factoids/DBCommon.pl +++ /dev/null @@ -1,151 +0,0 @@ -# -# DBStubs.pl: DB independent (I hope, heh) factoid support -# Author: dms -# Version: v0.6d (20000223) -# Created: 19991020 -# - -# use strict; # TODO - -##### -# Usage: &setFactInfo($faqtoid, $key, $val); -sub setFactInfo { - &sqlSet('factoids', - { factoid_key => $_[0] }, - { $_[1] => $_[2] } - ); -} - -##### -# Usage: &getFactInfo($faqtoid, [$what]); -sub getFactInfo { - return &sqlSelect('factoids', $_[1], { factoid_key => $_[0] } ); -} - -##### -# Usage: &getFactoid($faqtoid); -sub getFactoid { - return &getFactInfo($_[0], 'factoid_value'); -} - -##### -# Usage: &delFactoid($faqtoid); -sub delFactoid { - my ($faqtoid) = @_; - - &sqlDelete('factoids', { factoid_key => $faqtoid } ); - &status("DELETED $faqtoid"); - - return 1; -} - -##### -# Usage: &IsLocked($faqtoid); -sub IsLocked { - my ($faqtoid) = @_; - my $thisnuh = &getFactInfo($faqtoid, 'locked_by'); - - if (defined $thisnuh and $thisnuh ne '') { - if (!&IsHostMatch($thisnuh) and &IsFlag('o') ne 'o') { - &performReply("cannot alter locked factoids"); - return 1; - } - } - - return 0; -} - -##### -# Usage: &AddModified($faqtoid,$nuh); -sub AddModified { - my ($faqtoid,$nuh) = @_; - my $modified_by = &getFactInfo($faqtoid, 'modified_by'); - my (@modifiedlist, @modified, %modified); - - if (defined $modified_by) { - push(@modifiedlist, split(/\,/, $modified_by)); - } - push(@modifiedlist,$nuh); - - foreach (reverse @modifiedlist) { - /^(\S+)!(\S+)@(\S+)$/; - my $nick = lc $1; - next if (exists $modified{$nick}); - - $modified{$nick} = $_; - push(@modified,$nick); - } - - undef @modifiedlist; - - foreach (reverse @modified) { - push(@modifiedlist, $modified{$_}); - } - shift(@modifiedlist) while (scalar @modifiedlist > 3); - - &setFactInfo($faqtoid, 'modified_by', join(",",@modifiedlist)); - &setFactInfo($faqtoid, 'modified_time', time()); - - return 1; -} - -##### -### Commands which use the fundamental functions... Helpers? -##### - -##### -# Usage: &CmdLock($function,$faqtoid); -sub CmdLock { - my ($faqtoid) = @_; - - my $thisnuh = &getFactInfo($faqtoid,'locked_by'); - - if (defined $thisnuh and $thisnuh ne '') { - my $locked_by = (split(/\!/,$thisnuh))[0]; - &msg($who,"factoid \002$faqtoid\002 has already been locked by $locked_by."); - return 0; - } - - $thisnuh ||= &getFactInfo($faqtoid,'created_by'); - - # fixes bug found on 19991103. - # code needs to be reorganised though. - if ($thisnuh ne '') { - if (!&IsHostMatch($thisnuh) && IsFlag('o') ne 'o') { - &msg($who, "sorry, you are not allowed to lock '$faqtoid'."); - return 0; - } - } - - &performReply("locking factoid \002$faqtoid\002"); - &setFactInfo($faqtoid,'locked_by',$nuh); - &setFactInfo($faqtoid,'locked_time', time()); - - return 1; -} - -##### -# Usage: &CmdUnLock($faqtoid); -sub CmdUnLock { - my ($faqtoid) = @_; - - my $thisnuh = &getFactInfo($faqtoid,'locked_by'); - - if (!defined $thisnuh) { - &msg($who, "factoid \002$faqtoid\002 is not locked."); - return 0; - } - - if ($thisnuh ne '' and !&IsHostMatch($thisnuh) and &IsFlag('o') ne 'o') { - &msg($who, "sorry, you are not allowed to unlock factoid '$faqtoid'."); - return 0; - } - - &performReply("unlocking factoid \002$faqtoid\002"); - &setFactInfo($faqtoid,'locked_by', ''); - &setFactInfo($faqtoid,'locked_time', '0'); # pgsql complains if NOT NULL set. So set 0 which is the default - - return 1; -} - -1; diff --git a/blootbot/src/Factoids/Norm.pl b/blootbot/src/Factoids/Norm.pl deleted file mode 100644 index 980936c..0000000 --- a/blootbot/src/Factoids/Norm.pl +++ /dev/null @@ -1,103 +0,0 @@ -# -# Norm.pl: Norm. -# Author: Kevin Lenzo -# Version: 1997 -# - -# TODO: -# use strict; - -sub normquery { - my ($in) = @_; - - $in = " $in "; - - for ($in) { - # where blah is -> where is blah - s/ (where|what|who)\s+(\S+)\s+(is|are) / $1 $3 $2 /i; - - # where blah is -> where is blah - s/ (where|what|who)\s+(.*)\s+(is|are) / $1 $3 $2 /i; - - s/^\s*(.*?)\s*/$1/; - - s/be tellin\'?g?/tell/i; - s/ \'?bout/ about/i; - - s/,? any(hoo?w?|ways?)/ /ig; - s/,?\s*(pretty )*please\??\s*$/\?/i; - - # what country is ... - if ($in =~ - s/wh(at|ich)\s+(add?res?s|country|place|net (suffix|domain))/wh$1 /ig) { - if ((length($in) == 2) && ($in !~ /^\./)) { - $in = '.'.$in; - } - $in .= '?'; - } - - # profanity filters. just delete it - s/th(e|at|is) (((m(o|u)th(a|er) ?)?fuck(in\'?g?)?|hell|heck|(god-?)?damn?(ed)?) ?)+//ig; - s/wtf/where/gi; - s/this (.*) thingy?/ $1/gi; - s/this thingy? (called )?//gi; - s/ha(s|ve) (an?y?|some|ne) (idea|clue|guess|seen) /know /ig; - s/does (any|ne|some) ?(1|one|body) know //ig; - s/do you know //ig; - s/can (you|u|((any|ne|some) ?(1|one|body)))( please)? tell (me|us|him|her)//ig; - s/where (\S+) can \S+ (a|an|the)?//ig; - s/(can|do) (i|you|one|we|he|she) (find|get)( this)?/is/i; # where can i find - s/(i|one|we|he|she) can (find|get)/is/gi; # where i can find - s/(the )?(address|url) (for|to) //i; # this should be more specific - s/(where is )+/where is /ig; - s/\s+/ /g; - s/^\s+//; - if ($in =~ s/\s*[\/?!]*\?+\s*$//) { - $finalQMark = 1; - } - - s/\s+/ /g; - s/^\s*(.*?)\s*$/$1/; - s/^\s+|\s+$//g; # why twice, see Question.pl - } - - return $in; -} - -# for be-verbs -sub switchPerson { - my ($in) = @_; - - for ($in) { - # # fix genitives - s/(^|\W)\Q$who\Es\s+/$1${who}\'s /ig; - s/(^|\W)\Q$who\Es$/$1${who}\'s/ig; - s/(^|\W)\Q$who\E\'(\s|$)/$1${who}\'s$2/ig; - - s/(^|\s)i\'m(\W|$)/$1$who is$2/ig; - s/(^|\s)i\'ve(\W|$)/$1$who has$2/ig; - s/(^|\s)i have(\W|$)/$1$who has$2/ig; - s/(^|\s)i haven\'?t(\W|$)/$1$who has not$2/ig; - s/(^|\s)i(\W|$)/$1$who$2/ig; - s/ am\b/ is/i; - s/\bam /is/i; - s/(^|\s)(me|myself)(\W|$)/$1$who$3/ig; - s/(^|\s)my(\W|$)/$1${who}\'s$2/ig; # turn 'my' into name's - s/(^|\W)you\'?re(\W|$)/$1you are$2/ig; - - if ($addressed) { - my $mynick = 'UNDEF'; - $mynick = $conn->nick() if ($conn); - # is it safe to remove $in from here, too? - $in =~ s/yourself/$mynick/i; - $in =~ s/(^|\W)are you(\W|$)/$1is $mynick$2/ig; - $in =~ s/(^|\W)you are(\W|$)/$1$mynick is$2/ig; - $in =~ s/(^|\W)you(\W|$)/$1$mynick$2/ig; - $in =~ s/(^|\W)your(\W|$)/$1$mynick\'s$2/ig; - } - } - - return $in; -} - -1; diff --git a/blootbot/src/Factoids/Question.pl b/blootbot/src/Factoids/Question.pl deleted file mode 100644 index 1ba3b55..0000000 --- a/blootbot/src/Factoids/Question.pl +++ /dev/null @@ -1,303 +0,0 @@ -### -### Question.pl: Kevin Lenzo (c) 1997 -### - -## doQuestion -- -## if ($query == query) { -## return $value; -## } else { -## return NULL; -## } -## -## - -# use strict; # TODO - -use vars qw($query $reply $finalQMark $nuh $result $talkok $who $nuh); -use vars qw(%bots %forked); - -sub doQuestion { - # my doesn't allow variables to be inherinted, local does. - # following is used in math()... - local($query) = @_; - local($reply) = ''; - local $finalQMark = $query =~ s/\?+\s*$//; - $finalQMark += $query =~ s/\?\s*$//; - $query =~ s/^\s+|\s+$//g; - - if (!defined $query or $query =~ /^\s*$/) { - return ''; - } - - my $questionWord = ''; - - if (!$addressed) { - return '' unless ($finalQMark); - return '' unless &IsChanConf('minVolunteerLength') > 0; - return '' if (length $query < &::getChanConf('minVolunteerLength')); - } else { - ### TODO: this should be caught in Process.pl? - return '' unless ($talkok); - - # there is no flag to disable/enable asking factoids... - # so it was added... thanks zyxep! :) - if (&IsFlag('a') ne 'a' && &IsFlag('o') ne 'o') { - &status("$who tried to ask us when not allowed."); - return; - } - } - - # dangerous; common preambles should be stripped before here - if ($query =~ /^forget /i or $query =~ /^no, /) { - return if (exists $bots{$nuh}); - } - - if ($query =~ s/^literal\s+//i) { - &status("literal ask of '$query'."); - $literal = 1; - } - - # convert to canonical reference form - my $x; - my @query; - - push(@query, $query); # 1: push original. - - # valid factoid. - if ($query =~ s/[!.]$//) { - push(@query, $query); - } - - $x = &normquery($query); - push(@query, $x) if ($x ne $query); - $query = $x; - - $x = &switchPerson($query); - push(@query, $x) if ($x ne $query); - $query = $x; - - $query =~ s/\s+at\s*(\?*)$/$1/; # where is x at? - $query =~ s/^explain\s*(\?*)/$1/i; # explain x - $query = " $query "; # side whitespaces. - - my $qregex = join '|', keys %{ $lang{'qWord'} }; - - # purge prefix question string. - if ($query =~ s/^ ($qregex)//i) { - $questionWord = lc($1); - } - - if ($questionWord eq '' and $finalQMark and $addressed) { - $questionWord = 'where'; - } - $query =~ s/^\s+|\s+$//g; # bleh. hacked. - push(@query, $query) if ($query ne $x); - - if (&IsChanConf('factoidArguments') > 0) { - $result = &factoidArgs($query[0]); - - return $result if (defined $result); - } - - my @link; - for (my$i=0; $i= 5) { - &status("recursive link limit (5) reached."); - last; - } - - push(@link, $link); - my $newr = &getReply($link); - - # no such factoid. try commands - if (!defined $newr || $newr =~ /^0?$/) { - # support command redirection. - # recursive cmdHooks aswell :) - my $done = 0; - $done++ if &parseCmdHook($link); - $message = $link; - $done++ unless (&Modules()); - - return; - } - last if (!defined $newr or $newr eq ''); - $result = $newr; - } - - if (@link) { - &status("'$query' linked to: ".join(" => ", @link) ); - } - - if ($i != 0) { - &VERB("Question.pl: '$query[0]' did not exist; '$query[$i]' ($i) did",2); - } - - return $result; - } - - ### TODO: Use &Forker(); move function to Debian.pl - if (&IsChanConf('debianForFactoid') > 0) { - &loadMyModule('Debian'); - $result = &Debian::DebianFind($query); # ??? - ### TODO: debian module should tell, through shm, that it went - ### ok or not. -### return $result if (defined $result); - } - - if ($questionWord ne '' or $finalQMark) { - # if it has not been explicitly marked as a question - if ($addressed and $reply eq '') { - &status("notfound: <$who> ".join(' :: ', @query)) - if ($finalQMark); - - return '' unless (&IsParam('friendlyBots')); - - foreach (split /\s+/, $param{'friendlyBots'}) { - &msg($_, ":INFOBOT:QUERY <$who> $query"); - } - } - } - - return $reply; -} - -sub factoidArgs { - my($str) = @_; - my $result; - - # to make it eleeter, split each arg and use "blah OR blah or BLAH" - # which will make it less than linear => quicker! - # TODO: cache this, update cache when altered. !!! !!! !!! -# my $t = &timeget(); - my ($first) = split(/\s+/, $str); - - # ignore split to commands [dumb commands vs. factoids] (editing commands?) - return undef if $str =~ /\s+\=\~\s+s[\#\/\:]/; - my @list = &searchTable('factoids', 'factoid_key', 'factoid_key', "^cmd: $first "); -# my $delta_time = &timedelta($t); -# &DEBUG("factArgs: delta_time = $delta_time s"); -# &DEBUG("factArgs: list => ".scalar(@list) ); - - # from a design perspective, it's better to have the regex in - # the factoid key to reduce repetitive processing. - - # it does not matter if it's not alphabetically sorted. - foreach (sort { length($b) <=> length($a) } @list) { - next if (/#DEL#/); # deleted. - - s/^cmd: //i; -# &DEBUG("factarg: '$str' =~ /^$_\$/"); - my $arg = $_; - - # eval (evil!) code. cleaned up courtesy of lear. - my @vals; - eval { - @vals = ($str =~ /^$arg$/i); - }; - - if ($@) { - &WARN("factargs: regex failed! '$str' =~ /^$_\$/"); - next; - } - - next unless (@vals); - - if (defined $result) { - &WARN("factargs: '$_' matches aswell."); - next; - } - -# &DEBUG("vals => @vals"); - - &status("Question: factoid Arguments for '$str'"); - # TODO: use getReply() - need to modify it :( - my $i = 0; - my $q = "cmd: $_"; - my $r = &getFactoid($q); - if (!defined $r) { - &DEBUG("question: !result... should this happen?"); - return; - } - - # update stats. old mysql/sqlite don't do +1 - my ($count) = &sqlSelect('factoids', 'requested_count', { factoid_key => $q }); - $count++; - &sqlSet('factoids', {'factoid_key' => $q}, { - requested_by => $nuh, - requested_time => time(), - requested_count => $count - } ); - - # end of update stats. - - $result = $r; - - $result =~ s/^\((.*?)\): //; - my $vars = $1; - - # start nasty hack to get partial &getReply() functionality. - $result = &SARit($result); - - foreach ( split(',', $vars) ) { - my $val = $vals[$i]; -# &DEBUG("val => $val"); - - if (!defined $val) { - &status("factArgs: vals[$i] == undef; not SARing '$_' for '$str'"); - next; - } - - my $done = 0; - my $old = $result; - while (1) { -# &DEBUG("Q: result => $result (1before)"); - $result = &substVars($result,1); -# &DEBUG("Q: result => $result (1after)"); - - last if ($old eq $result); - $old = $result; - $done++; - } - - # hack. - $vals[$i] =~ s/^me$/$who/gi; - -# if (!$done) { - &status("factArgs: SARing '$_' to '$vals[$i]'."); - $result =~ s/\Q$_\E/$vals[$i]/g; -# } - $i++; - } - - # rest of nasty hack to get partial &getReply() functionality. - $result =~ s/^\s*\s*(.*)/\cAACTION $1\cA/i; - $result =~ s/^\s*\s*//i; - -# well... lets go through all of them. not advisable if we have like -# 1000 commands, heh. -# return $result; - $cmdstats{'Factoid Commands'}++; - } - - return $result; -} - -1; diff --git a/blootbot/src/Factoids/Reply.pl b/blootbot/src/Factoids/Reply.pl deleted file mode 100644 index 1ab437a..0000000 --- a/blootbot/src/Factoids/Reply.pl +++ /dev/null @@ -1,367 +0,0 @@ -### -### Reply.pl: Kevin Lenzo (c) 1997 -### - -## -# x is y === $lhs $mhs $rhs -# -# lhs - factoid. -# mhs - verb. -# rhs - factoid message. -## - -# use strict; # TODO -use POSIX qw(strftime); - -use vars qw($msgType $uh $lastWho $ident); -use vars qw(%lang %lastWho); - -sub getReply { - my($message) = @_; - my($lhs,$mhs,$rhs); - my($reply, $count, $fauthor, $result, $factoid, $search, @searches); - $orig{message} = $message; - - if (!defined $message or $message =~ /^\s*$/) { - &WARN("getR: message == NULL."); - return ''; - } - - $message =~ tr/A-Z/a-z/; - - @searches = split(/\s+/, &getChanConfDefault('factoidSearch', '_default', $chan)); - &::DEBUG("factoidSearch: $chan is: " . join(':', @searches)); - # requesting the _default one, ignore factoidSearch - if ($message =~ /^_default\s+/) { - @searches = ('_default'); - $message =~ s/^_default\s+//; - } - - # check for factoids with each prefix - foreach $search (@searches) { - if ($search eq '$chan') { - $factoid = "$chan $message"; - } elsif ($search eq '_default') { - $factoid = $message; - } else { - $factoid = "$search $message"; - } - ($count, $fauthor, $result) = &sqlSelect('factoids', - "requested_count,created_by,factoid_value", - { factoid_key => $factoid } - ); - last if ($result); - } - - if ($result) { - $lhs = $message; - $mhs = 'is'; - $rhs = $result; - - return "\"$factoid\" $mhs \"$rhs\"" if ($literal); - } else { - return ''; - } - - # if there was a head... - my(@poss) = split '\|\|', $result; - $poss[0] =~ s/^\s//; - $poss[$#poss] =~ s/\s$//; - - if (@poss > 1) { - $result = &getRandom(@poss); - $result =~ s/^\s*//; - } - - $result = &SARit($result); - - $reply = $result; - if ($result ne '') { - ### AT LAST, REPEAT PREVENTION CODE REMOVED IN FAVOUR OF GLOBAL - ### FLOOD REPETION AND PROTECTION. -20000124 - - # stats code. - ### FIXME: old mysql/sqlite doesn't support - ### "requested_count=requested_count+1". - $count++; - &sqlSet('factoids', {'factoid_key' => $factoid}, { - requested_by => $nuh, - requested_time => time(), - requested_count => $count - } ); - - # TODO: rename $real to something else! - my $real = 0; -# my $author = &getFactInfo($lhs,'created_by') || ''; -# $real++ if ($author =~ /^\Q$who\E\!/); -# $real++ if (&IsFlag('n')); - $real = 0 if ($msgType =~ /public/); - - ### fix up the reply. - # only remove '' - if (!$real and $reply =~ s/^\s*\s*//i) { - # 'are' fix. - if ($reply =~ s/^are /$lhs are /i) { - &VERB("Reply.pl: el-cheapo 'are' fix executed.",2); - } - - } elsif (!$real and $reply =~ s/^\s*\s*(.*)/\cAACTION $1\cA/i) { - # only remove '' and make it an action. - } else { # not a short reply - - ### bot->bot reply. - if (exists $bots{$nuh} and $rhs !~ /^\s*$/) { - return "$lhs $mhs $rhs"; - } - - ### bot->person reply. - # result is random if separated by '||'. - # rhs is full factoid with '||'. - if ($mhs eq 'is') { - $reply = &getRandom(keys %{ $lang{'factoid'} }); - $reply =~ s/##KEY/$lhs/; - $reply =~ s/##VALUE/$result/; - } else { - $reply = "$lhs $mhs $result"; - } - - if ($reply =~ s/^\Q$who\E is/you are/i) { - # fix the person. - } else { - if ($reply =~ /^you are / or $reply =~ / you are /) { - return if ($addressed); - } - } - } - } - - # remove excessive beginning and end whitespaces. - $reply =~ s/^\s+|\s+$//g; - - if ($reply =~ /^\s+$/) { - &DEBUG("Reply: Null factoid ($message)"); - return ''; - } - - return $reply unless ($reply =~ /\$/); - - ### - ### $ SUBSTITUTION. - ### - - # don't evaluate if it has factoid arguments. -# if ($message =~ /^cmd:/i) { -# &status("Reply: not doing substVars (eval dollar vars)"); -# } else { - $reply = &substVars($reply,1); -# } - - $reply; -} - -sub smart_replace { - my ($string) = @_; - my ($l,$r) = (0,0); # l = left, r = right. - my ($s,$t) = (0,0); # s = start, t = marker. - my $i = 0; - my $old = $string; - my @rand; - - foreach (split //, $string) { - - if ($_ eq "(") { - if (!$l and !$r) { - $s = $i; - $t = $i; - } - - $l++; - $r--; - } - - if ($_ eq ")") { - $r++; - $l--; - - if (!$l and !$r) { - my $substr = substr($old,$s,$i-$s+1); - push(@rand, substr($old,$t+1,$i-$t-1) ); - - my $rand = $rand[rand @rand]; -# &status("SARing '$substr' to '$rand'."); - $string =~ s/\Q$substr\E/$rand/; - undef @rand; - } - } - - if ($_ eq "|" and $l+$r== 0 and $l==1) { - push(@rand, substr($old,$t+1,$i-$t-1) ); - $t = $i; - } - - $i++; - } - - if ($old eq $string) { - &WARN("smart_replace: no subst made. (string => $string)"); - } - - return $string; -} - -sub SARit { - my($txt) = @_; - my $done = 0; - - # (blah1|blah2)? - while ($txt =~ /\((.*?)\)\?/) { - my $str = $1; - if (rand() > 0.5) { # fix. - &status("Factoid transform: keeping '$str'."); - $txt =~ s/\(\Q$str\E\)\?/$str/; - } else { # remove - &status("Factoid transform: removing '$str'."); - $txt =~ s/\(\Q$str\E\)\?\s?//; - } - $done++; - last if ($done >= 10); # just in case. - } - $done = 0; - - # EG: (0-32768) => 6325 - ### TODO: (1-10,20-30,40) => 24 - while ($txt =~ /\((\d+)-(\d+)\)/) { - my ($lower,$upper) = ($1,$2); - my $new = int(rand $upper-$lower) + $lower; - - &status("SARing '$&' to '$new' (2)."); - $txt =~ s/$&/$new/; - $done++; - last if ($done >= 10); # just in case. - } - $done = 0; - - # EG: (blah1|blah2|blah3|) => blah1 - while ($txt =~ /.*\((.*\|.*?)\).*/) { - $txt = &smart_replace($txt); - - $done++; - last if ($done >= 10); # just in case. - } - &status("Reply.pl: $done SARs done.") if ($done); - - # type - # - while ($txt =~ /(.*)<\/URL>/){ - &status("we have to norm this stuff, SARing"); - my $foobar = $1; - if ($foobar =~ m/(http:\/\/[^?]+)\?(.*)/){ - my ($pig1,$pig2) = ($1,$2); - &status("SARing using URLencode"); - $pig2=~s/([^\w])/sprintf("%%%02x",ord($1))/gie; - $foobar=$pig1."?".$pig2; - } - $txt =~ s/(.*)<\/URL>/$foobar/; - } - return $txt; -} - -sub substVars { - my($reply,$flag) = @_; - - # $date, $time, $day. - # TODO: support localtime. - my $date = strftime("%Y.%m.%d", gmtime()); - $reply =~ s/\$date/$date/gi; - my $time = strftime("%k:%M:%S", gmtime()); - $reply =~ s/\$time/$time/gi; - my $day = strftime("%A", gmtime()); - $reply =~ s/\$day/$day/gi; - - # support $ident when I have multiple nicks - my $mynick = $conn->nick() if $conn; - - # dollar variables. - if ($flag) { - $reply =~ s/\$nick/$who/g; - $reply =~ s/\$who/$who/g; # backward compat. - } - - if ($reply =~ /\$(user(name)?|host)/) { - my ($username, $hostname) = split /\@/, $uh; - $reply =~ s/\$user(name)?/$username/g; - $reply =~ s/\$host(name)?/$hostname/g; - } - $reply =~ s/\$chan(nel)?/$talkchannel/g; - if ($msgType =~ /public/) { - $reply =~ s/\$lastspeaker/$lastWho{$talkchannel}/g; - } else { - $reply =~ s/\$lastspeaker/$lastWho/g; - } - - if ($reply =~ /\$rand/) { - my $rand = rand(); - - # $randnick. - if ($reply =~ /\$randnick/) { - my @nicks = keys %{ $channels{$chan}{''} }; - my $randnick = $nicks[ int($rand*$#nicks) ]; - $reply =~ s/\$randnick/$randnick/g; - } - - # eg: $rand100.3 - if ($reply =~ /\$rand(\d+)(\.(\d+))?/) { - my $max = $1; - my $dot = $3 || 0; - my $orig = $&; - #&DEBUG("dot => $dot, max => $max, rand=>$rand"); - $rand = sprintf("%.*f", $dot, $rand*$max); - - &DEBUG("swapping $orig to $rand"); - $reply =~ s/\Q$orig\E/$rand/eg; - } else { - $reply =~ s/\$rand/$rand/g; - } - } - - $reply =~ s/\$ident/$mynick/g; - - if ($reply =~ /\$startTime/) { - my $time = scalar(gmtime $^T); - $reply =~ s/\$startTime/$time/; - } - - if ($reply =~ /\$uptime/) { - my $uptime = &Time2String(time() - $^T); - $reply =~ s/\$uptime/$uptime/; - } - - if ($reply =~ /\$factoids/) { - my $factoids = &countKeys('factoids'); - $reply =~ s/\$factoids/$factoids/; - } - - if ($reply =~ /\$Fupdate/) { - my $x = "\002$count{'Update'}\002 ". - &fixPlural('modification', $count{'Update'}); - $reply =~ s/\$Fupdate/$x/; - } - - if ($reply =~ /\$Fquestion/) { - my $x = "\002$count{'Question'}\002 ". - &fixPlural('question', $count{'Question'}); - $reply =~ s/\$Fquestion/$x/; - } - - if ($reply =~ /\$Fdunno/) { - my $x = "\002$count{'Dunno'}\002 ". - &fixPlural('dunno', $count{'Dunno'}); - $reply =~ s/\$Fdunno/$x/; - } - - $reply =~ s/\$memusage/$memusage/; - - return $reply; -} - -1; diff --git a/blootbot/src/Factoids/Statement.pl b/blootbot/src/Factoids/Statement.pl deleted file mode 100644 index 8eaa5e1..0000000 --- a/blootbot/src/Factoids/Statement.pl +++ /dev/null @@ -1,114 +0,0 @@ -### -### Statement.pl: Kevin Lenzo (c) 1997 -### - -## -## doStatement -- -## -## decide if $in is a statement, and if so, -## - update the db -## - return feedback statement -## -## otherwise return -## - null for confused. -## - -# use strict; # TODO - -sub doStatement { - my($in) = @_; - - $in =~ s/\\(\S+)/\#$1\#/g; # fix the backslash. - $in =~ s/^no([, ]+)//i; # 'no, '. - - # check if we need to be addressed and if we are - return unless ($learnok); - - my($urlType) = ''; - - # prefix www with http:// and ftp with ftp:// - $in =~ s/ www\./ http:\/\/www\./ig; - $in =~ s/ ftp\./ ftp:\/\/ftp\./ig; - - $urlType = 'about' if ($in =~ /\babout:/i); - $urlType = 'afp' if ($in =~ /\bafp:/); - $urlType = 'file' if ($in =~ /\bfile:/); - $urlType = 'palace' if ($in =~ /\bpalace:/); - $urlType = 'phoneto' if ($in =~ /\bphone(to)?:/); - if ($in =~ /\b(news|http|ftp|gopher|telnet):\s*\/\/[\-\w]+(\.[\-\w]+)+/) { - $urlType = $1; - } - - # acceptUrl. - if (&IsParam('acceptUrl')) { - if ($param{'acceptUrl'} eq 'REQUIRE') { # require url type. - return if ($urlType eq ''); - } elsif ($param{'acceptUrl'} eq 'REJECT') { - &status("REJECTED URL entry") if (&IsParam('VERBOSITY')); - return unless ($urlType eq ''); - } else { - # OPTIONAL - } - } - - # learn statement. '$lhs is|are $rhs' - if ($in =~ /(^|\s)(is|are)(\s|$)/i) { - my($lhs, $mhs, $rhs) = ($`, $&, $'); - - # allows factoid arguments to be updated. -lear. - $lhs =~ s/^(cmd: )?(.*)/$1||'' . lc $2/e; - - # discard article. - $lhs =~ s/^(the|da|an?)\s+//i; - - # remove excessive initial and final whitespaces. - $lhs =~ s/^\s+|\s+$//g; - $mhs =~ s/^\s+|\s+$//g; - $rhs =~ s/^\s+|\s+$//g; - - # break if either lhs or rhs is NULL. - if ($lhs eq '' or $rhs eq '') { - return "NOT-A-STATEMENT"; - } - - # lets check if it failed. - if (&validFactoid($lhs,$rhs) == 0) { - if ($addressed) { - &status("IGNORE statement: <$who> $message"); - &performReply( &getRandom(keys %{ $lang{'confused'} }) ); - } - return; - } - - # uncomment to prevent HUNGRY learning of rhs with whitespace - #return if (!$addressed and $lhs =~ /\s+/); - &::DEBUG("doStatement: $in:$lhs:$mhs:$rhs"); - - &status("statement: <$who> $message"); - - # change "#*#" back to '*' because of '\' sar to '#blah#'. - $lhs =~ s/\#(\S+)\#/$1/g; - $rhs =~ s/\#(\S+)\#/$1/g; - - $lhs =~ s/\?+\s*$//; # strip off '?'. - - # verify the update statement whether there are any weird - # characters. - ### this can be simplified. - foreach (split //, $lhs.$rhs) { - my $ord = ord $_; - if ($ord > 170 and $ord < 220) { - &status("statement: illegal character '$_' $ord."); - &performAddressedReply("i'm not going to learn illegal characters"); - return; - } - } - - # success. - return if (&update($lhs, $mhs, $rhs)); - } - - return 'CONTINUE'; -} - -1; diff --git a/blootbot/src/Factoids/Update.pl b/blootbot/src/Factoids/Update.pl deleted file mode 100644 index b948266..0000000 --- a/blootbot/src/Factoids/Update.pl +++ /dev/null @@ -1,228 +0,0 @@ -# -# Update.pl: Add or modify factoids in the db. -# Author: Kevin Lenzo -# dms -# Version: 19991209 -# Created: 1997 -# - -# use strict; # TODO - -sub update { - my($lhs, $mhs, $rhs) = @_; - - for ($lhs) { - s/^i (heard|think) //i; - s/^some(one|1|body) said //i; - s/\s+/ /g; - } - - # locked. - return if (&IsLocked($lhs) == 1); - - # profanity. - if (&IsParam('profanityCheck') and &hasProfanity($rhs)) { - &performReply("please, watch your language."); - return 1; - } - - # teaching. - if (&IsFlag('t') ne 't' && &IsFlag('o') ne 'o') { - &msg($who, "permission denied."); - &status("alert: $who wanted to teach me."); - return 1; - } - - # invalid verb. - if ($mhs !~ /^(is|are)$/i) { - &ERROR("UNKNOWN verb: $mhs."); - return; - } - - # check if the arguments are too long to be stored in our table. - my $toolong = 0; - $toolong++ if (length $lhs > $param{'maxKeySize'}); - $toolong++ if (length $rhs > $param{'maxDataSize'}); - if ($toolong) { - &performAddressedReply("that's too long"); - return 1; - } - - # also checking. - my $also = ($rhs =~ s/^-?also //i); - my $also_or = ($also and $rhs =~ s/\s+(or|\|\|)\s+//); - - # factoid arguments handler. - # must start with a non-variable - if (&IsChanConf('factoidArguments') > 0 and $lhs =~ /^[^\$]+.*\$/) { - &status("Update: Factoid Arguments found."); - &status("Update: orig lhs => '$lhs'."); - &status("Update: orig rhs => '$rhs'."); - - my @list; - my $count = 0; - $lhs =~ s/^/cmd: /; - while ($lhs =~ s/\$(\S+)/(.*?)/) { - push(@list, "\$$1"); - $count++; - last if ($count >= 10); - } - - if ($count >= 10) { - &msg($who, "error: could not SAR properly."); - &DEBUG("error: lhs => '$lhs' rhs => '$rhs'."); - return; - } - - my $z = join(',',@list); - $rhs =~ s/^/($z): /; - - &status("Update: new lhs => '$lhs' rhs => '$rhs'."); - } - - # the fun begins. - my $exists = &getFactoid($lhs); - - if (!$exists) { - # nice 'are' hack (or work-around). - if ($mhs =~ /^are$/i and $rhs !~ /<\S+>/) { - &status("Update: 'are' hack detected."); - $mhs = 'is'; - $rhs = " are ". $rhs; - } - - &status("enter: <$who> \'$lhs\' =$mhs=> \'$rhs\'"); - $count{'Update'}++; - - &performAddressedReply('okay'); - - &sqlInsert('factoids', { - created_by => $nuh, - created_time => time(), # modified time. - factoid_key => $lhs, - factoid_value => $rhs, - } ); - - if (!defined $rhs or $rhs eq '') { - &ERROR("Update: rhs1 == NULL."); - } - - return 1; - } - - # factoid exists. - if ($exists eq $rhs) { - # this catches the following situation: (right or wrong?) - # "test is test" - # "test is also test" - &performAddressedReply("i already had it that way"); - return 1; - } - - if ($also) { # 'is also'. - if ($exists =~ /^ see /i) { - &TODO("Update.pl: append to linked factoid."); - } - - if ($also_or) { # 'is also ||'. - $rhs = $exists.' || '.$rhs; - } else { -# if ($exists =~ s/\,\s*$/, /) { - if ($exists =~ /\,\s*$/) { - &DEBUG("current has trailing comma, just append as is"); - &DEBUG("Up: exists => $exists"); - &DEBUG("Up: rhs => $rhs"); - # $rhs =~ s/^\s+//; - # $rhs = $exists." ".$rhs; # keep comma. - } - - if ($exists =~ /\.\s*$/) { - &DEBUG("current has trailing period, just append as is with 2 WS"); - &DEBUG("Up: exists => $exists"); - &DEBUG("Up: rhs => $rhs"); - # $rhs =~ s/^\s+//; - # use ucfirst();? - # $rhs = $exists." ".$rhs; # keep comma. - } - - if ($rhs =~ /^[A-Z]/) { - if ($rhs =~ /\w+\s*$/) { - &status("auto insert period to factoid."); - $rhs = $exists.". ".$rhs; - } else { # '?' or '.' assumed at end. - &status("orig factoid already had trailing symbol; not adding period."); - $rhs = $exists." ".$rhs; - } - } elsif ($exists =~ /[\,\.\-]\s*$/) { - &VERB("U: current has trailing symbols; inserting whitespace + new.",2); - $rhs = $exists." ".$rhs; - } elsif ($rhs =~ /^\./) { - &VERB("U: new text has ^.; appending directly",2); - $rhs = $exists.$rhs; - } else { - $rhs = $exists.', or '.$rhs; - } - } - - # max length check again. - if (length $rhs > $param{'maxDataSize'}) { - if (length $rhs > length $exists) { - &performAddressedReply("that's too long"); - return 1; - } else { - &status("Update: new length is still longer than maxDataSize but less than before, we'll let it go."); - } - } - - &performAddressedReply('okay'); - - $count{'Update'}++; - &status("update: <$who> \'$lhs\' =$mhs=> \'$rhs\'; was \'$exists\'"); - &sqlSet('factoids', {'factoid_key' => $lhs}, { - modified_by => $nuh, - modified_time => time(), - factoid_value => $rhs, - } ); - - if (!defined $rhs or $rhs eq '') { - &ERROR("Update: rhs1 == NULL."); - } - } else { # not 'also' - - if (!$correction_plausible) { # "no, blah is ..." - if ($addressed) { - &performStrictReply("...but \002$lhs\002 is already something else..."); - &status("FAILED update: <$who> \'$lhs\' =$mhs=> \'$rhs\'"); - } - return 1; - } - - my $author = &getFactInfo($lhs, 'created_by') || ''; - - if (IsFlag('m') ne 'm' && IsFlag('o') ne 'o' && - $author !~ /^\Q$who\E\!/i - ) { - &msg($who, "you can't change that factoid."); - return 1; - } - - &performAddressedReply('okay'); - - $count{'Update'}++; - &status("update: <$who> \'$lhs\' =$mhs=> \'$rhs\'; was \'$exists\'"); - - &sqlSet('factoids', {'factoid_key' => $lhs}, { - modified_by => $nuh, - modified_time => time(), - factoid_value => $rhs, - } ); - - if (!defined $rhs or $rhs eq '') { - &ERROR("Update: rhs1 == NULL."); - } - } - - return 1; -} - -1; diff --git a/blootbot/src/Files.pl b/blootbot/src/Files.pl deleted file mode 100644 index 938f615..0000000 --- a/blootbot/src/Files.pl +++ /dev/null @@ -1,83 +0,0 @@ -# -# Files.pl: Open and close, read and probably write files. -# Author: dms -# Version: v0.3 (20010120) -# Created: 19991221 -# - -use strict; - -use vars qw(%lang %ircPort); -use vars qw(@ircServers); -use vars qw($bot_config_dir); - -# File: Language support. -sub loadLang { - my ($file) = @_; - my $langCount = 0; - my $replyName; - - if (!open(FILE, $file)) { - &ERROR("Failed reading lang file ($file): $!"); - exit 0; - } - - undef %lang; # for rehash. - - while () { - chop; - if ($_ eq '' || /^#/) { - undef $replyName; - next; - } - - if (!/^\s/) { - $replyName = $_; - next; - } - - s/^[\s\t]+//g; - if (!$replyName) { - &status("loadLang: bad line ('$_')"); - next; - } - - $lang{$replyName}{$_} = 1; - $langCount++; - } - close FILE; - - $file =~ s/^.*\///; - &status("Loaded $file ($langCount items)"); -} - -# File: Irc Servers list. -sub loadIRCServers { - my ($file) = $bot_config_dir."/blootbot.servers"; - @ircServers = (); - %ircPort = (); - - if (!open(FILE, $file)) { - &ERROR("Failed reading server list ($file): $!"); - exit 0; - } - - while () { - chop; - next if /^\s*$/; - next if /^[\#\[ ]/; - - if (/^(\S+)(:(\d+))?$/) { - push(@ircServers,$1); - $ircPort{$1} = ($3 || 6667); - } else { - &status("loadIRCServers: invalid line => '$_'."); - } - } - close FILE; - - $file =~ s/^.*\///; - &status("Loaded $file (". scalar(@ircServers) ." servers)"); -} - -1; diff --git a/blootbot/src/IRC/Irc.pl b/blootbot/src/IRC/Irc.pl deleted file mode 100644 index 5159832..0000000 --- a/blootbot/src/IRC/Irc.pl +++ /dev/null @@ -1,977 +0,0 @@ -# -# Irc.pl: IRC core stuff. -# Author: dms -# Version: 20000126 -# NOTE: Based on code by Kevin Lenzo & Patrick Cole (c) 1997 -# - -use strict; - -no strict 'refs'; -no strict 'subs'; # IN/STDIN - -use vars qw(%floodjoin %nuh %dcc %cache %conns %channels %param %mask - %chanconf %orig %ircPort %ircstats %last %netsplit); -use vars qw($irc $nickserv $conn $msgType $who $talkchannel - $addressed $postprocess); -use vars qw($notcount $nottime $notsize $msgcount $msgtime $msgsize - $pubcount $pubtime $pubsize); -use vars qw($b_blue $ob); -use vars qw(@ircServers); - -#use open ':utf8'; -#use open ':std'; - -$nickserv = 0; -my $maxlinelen = 400; - -sub ircloop { - my $error = 0; - my $lastrun = 0; - -loop:; - while (my $host = shift @ircServers) { - # JUST IN CASE. irq was complaining about this. - if ($lastrun == time()) { - &DEBUG("ircloop: hrm... lastrun == time()"); - $error++; - sleep 10; - next; - } - - if (!defined $host) { - &DEBUG("ircloop: ircServers[x] = NULL."); - $lastrun = time(); - next; - } - next unless (exists $ircPort{$host}); - - my $retval = &irc($host, $ircPort{$host}); - next unless (defined $retval and $retval == 0); - $error++; - - if ($error % 3 == 0 and $error != 0) { - &status("IRC: Could not connect."); - &status("IRC: "); - next; - } - - if ($error >= 3*2) { - &status("IRC: cannot connect to any IRC servers; stopping."); - &shutdown(); - exit 1; - } - } - - &status("IRC: ok, done one cycle of IRC servers; trying again."); - - &loadIRCServers(); - goto loop; -} - -sub irc { - my ($server,$port) = @_; - - $irc = new Net::IRC; - - # TODO: move all this to an sql table - my $iaddr = inet_aton($server); - my $paddr = sockaddr_in($port, $iaddr); - my $proto = getprotobyname('tcp'); - - # why was this here? - #select STDOUT; - - # host->ip. - my $resolve; - if ($server =~ /\D$/) { - my $packed = scalar(gethostbyname($server)); - - if (!defined $packed) { - &status(" cannot resolve $server."); - return 0; - } - - $resolve = inet_ntoa($packed); - ### warning in Sys/Hostname line 78??? - ### caused inside Net::IRC? - } - - my %args = ( - Nick => $param{'ircNick'}, - Server => $server, - Port => $port, - Ircname => $param{'ircName'}, - ); - $args{'LocalAddr'} = $param{'ircHost'} if ($param{'ircHost'}); - $args{'Password'} = $param{'ircPasswd'} if ($param{'ircPasswd'}); - - foreach my $mynick (split ',', $param{'ircNick'}) { - &status("Connecting to port $port of server $server ($resolve) as $mynick ..."); - $args{'Nick'} = $mynick; - $conns{$mynick} = $irc->newconn(%args); - if (!defined $conns{$mynick}) { - &ERROR("IRC: connection failed."); - &ERROR("add \"set ircHost 0.0.0.0\" to your config. If that does not work"); - &ERROR("Please check /etc/hosts to see if you have a localhost line like:"); - &ERROR("127.0.0.1 localhost localhost"); - &ERROR("If this is still a problem, please contact the maintainer."); - } - $conns{$mynick}->maxlinelen($maxlinelen); - # handler stuff. - $conns{$mynick}->add_global_handler('caction', \&on_action); - $conns{$mynick}->add_global_handler('cdcc', \&on_dcc); - $conns{$mynick}->add_global_handler('cping', \&on_ping); - $conns{$mynick}->add_global_handler('crping', \&on_ping_reply); - $conns{$mynick}->add_global_handler('cversion', \&on_version); - $conns{$mynick}->add_global_handler('crversion', \&on_crversion); - $conns{$mynick}->add_global_handler('dcc_open', \&on_dcc_open); - $conns{$mynick}->add_global_handler('dcc_close', \&on_dcc_close); - $conns{$mynick}->add_global_handler('chat', \&on_chat); - $conns{$mynick}->add_global_handler('msg', \&on_msg); - $conns{$mynick}->add_global_handler('public', \&on_public); - $conns{$mynick}->add_global_handler('join', \&on_join); - $conns{$mynick}->add_global_handler('part', \&on_part); - $conns{$mynick}->add_global_handler('topic', \&on_topic); - $conns{$mynick}->add_global_handler('invite', \&on_invite); - $conns{$mynick}->add_global_handler('kick', \&on_kick); - $conns{$mynick}->add_global_handler('mode', \&on_mode); - $conns{$mynick}->add_global_handler('nick', \&on_nick); - $conns{$mynick}->add_global_handler('quit', \&on_quit); - $conns{$mynick}->add_global_handler('notice', \&on_notice); - $conns{$mynick}->add_global_handler('whoischannels', \&on_whoischannels); - $conns{$mynick}->add_global_handler('useronchannel', \&on_useronchannel); - $conns{$mynick}->add_global_handler('whois', \&on_whois); - $conns{$mynick}->add_global_handler('other', \&on_other); - $conns{$mynick}->add_global_handler('disconnect', \&on_disconnect); - $conns{$mynick}->add_global_handler([251,252,253,254,255], \&on_init); -# $conns{$mynick}->add_global_handler(302, \&on_init); # userhost - $conns{$mynick}->add_global_handler(303, \&on_ison); # notify. - $conns{$mynick}->add_global_handler(315, \&on_endofwho); - $conns{$mynick}->add_global_handler(422, \&on_endofwho); # nomotd. - $conns{$mynick}->add_global_handler(324, \&on_modeis); - $conns{$mynick}->add_global_handler(333, \&on_topicinfo); - $conns{$mynick}->add_global_handler(352, \&on_who); - $conns{$mynick}->add_global_handler(353, \&on_names); - $conns{$mynick}->add_global_handler(366, \&on_endofnames); - $conns{$mynick}->add_global_handler(376, \&on_endofmotd); # on_connect. - $conns{$mynick}->add_global_handler(433, \&on_nick_taken); - $conns{$mynick}->add_global_handler(439, \&on_targettoofast); - # for proper joinnextChan behaviour - $conns{$mynick}->add_global_handler(471, \&on_chanfull); - $conns{$mynick}->add_global_handler(473, \&on_inviteonly); - $conns{$mynick}->add_global_handler(474, \&on_banned); - $conns{$mynick}->add_global_handler(475, \&on_badchankey); - $conns{$mynick}->add_global_handler(443, \&on_useronchan); - # end of handler stuff. - } - - &clearIRCVars(); - - # change internal timeout value for scheduler. - $irc->{_timeout} = 10; # how about 60? - # Net::IRC debugging. - $irc->{_debug} = 1; - - $ircstats{'Server'} = "$server:$port"; - - # works? needs to actually do something - # should likely listen on a tcp port instead - #$irc->addfh(STDIN, \&on_stdin, 'r'); - - &status("starting main loop"); - - $irc->start; -} - -###################################################################### -######## IRC ALIASES IRC ALIASES IRC ALIASES IRC ALIASES ####### -###################################################################### - -sub rawout { - my ($buf) = @_; - $buf =~ s/\n//gi; - - # slow down a bit if traffic is 'high'. - # need to take into account time of last message sent. - if ($last{buflen} > 256 and length($buf) > 256) { - sleep 1; - } - - $conn->sl($buf) if (&whatInterface() =~ /IRC/); - - $last{buflen} = length($buf); -} - -sub say { - my ($msg) = @_; - my $mynick = $conn->nick(); - if (!defined $msg) { - $msg ||= 'NULL'; - &WARN("say: msg == $msg."); - return; - } - - if (&getChanConf('silent', $talkchannel)) { - &DEBUG("say: silent in $talkchannel, not saying $msg"); - return; - } - - if ( $postprocess ) { - undef $postprocess; - } elsif ($postprocess = &getChanConf('postprocess', $talkchannel)) { - &DEBUG("say: $postprocess $msg"); - &parseCmdHook($postprocess . ' ' . $msg); - undef $postprocess; - return; - } - - &status("<$mynick/$talkchannel> $msg"); - - return unless (&whatInterface() =~ /IRC/); - - $msg = 'zero' if ($msg =~ /^0+$/); - - my $t = time(); - - if ($t == $pubtime) { - $pubcount++; - $pubsize += length $msg; - - my $i = &getChanConfDefault('sendPublicLimitLines', 3, $chan); - my $j = &getChanConfDefault('sendPublicLimitBytes', 1000, $chan); - - if ( ($pubcount % $i) == 0 and $pubcount) { - sleep 1; - } elsif ($pubsize > $j) { - sleep 1; - $pubsize -= $j; - } - - } else { - $pubcount = 0; - $pubtime = $t; - $pubsize = length $msg; - } - - $conn->privmsg($talkchannel, $msg); -} - -sub msg { - my ($nick, $msg) = @_; - if (!defined $nick) { - &ERROR("msg: nick == NULL."); - return; - } - - if (!defined $msg) { - $msg ||= 'NULL'; - &WARN("msg: msg == $msg."); - return; - } - - # some say() end up here (eg +help) - if (&getChanConf('silent', $nick)) { - &DEBUG("msg: silent in $nick, not saying $msg"); - return; - } - - &status(">$nick< $msg"); - - return unless (&whatInterface() =~ /IRC/); - my $t = time(); - - if ($t == $msgtime) { - $msgcount++; - $msgsize += length $msg; - - my $i = &getChanConfDefault('sendPrivateLimitLines', 3, $chan); - my $j = &getChanConfDefault('sendPrivateLimitBytes', 1000, $chan); - if ( ($msgcount % $i) == 0 and $msgcount) { - sleep 1; - } elsif ($msgsize > $j) { - sleep 1; - $msgsize -= $j; - } - - } else { - $msgcount = 0; - $msgtime = $t; - $msgsize = length $msg; - } - - $conn->privmsg($nick, $msg); -} - -# Usage: &action(nick || chan, txt); -sub action { - my $mynick = $conn->nick(); - my ($target, $txt) = @_; - if (!defined $txt) { - &WARN("action: txt == NULL."); - return; - } - - if (&getChanConf('silent', $target)) { - &DEBUG("action: silent in $target, not doing $txt"); - return; - } - - if (length $txt > 480) { - &status("action: txt too long; truncating."); - chop($txt) while (length $txt > 480); - } - - &status("* $mynick/$target $txt"); - $conn->me($target, $txt); -} - -# Usage: ¬ice(nick || chan, txt); -sub notice { - my ($target, $txt) = @_; - if (!defined $txt) { - &WARN("notice: txt == NULL."); - return; - } - - &status("-$target- $txt"); - - my $t = time(); - - if ($t == $nottime) { - $notcount++; - $notsize += length $txt; - - my $i = &getChanConfDefault('sendNoticeLimitLines', 3, $chan); - my $j = &getChanConfDefault('sendNoticeLimitBytes', 1000, $chan); - - if ( ($notcount % $i) == 0 and $notcount) { - sleep 1; - } elsif ($notsize > $j) { - sleep 1; - $notsize -= $j; - } - - } else { - $notcount = 0; - $nottime = $t; - $notsize = length $txt; - } - - $conn->notice($target, $txt); -} - -sub DCCBroadcast { - my ($txt,$flag) = @_; - - ### FIXME: flag not supported yet. - - foreach (keys %{ $dcc{'CHAT'} }) { - $conn->privmsg($dcc{'CHAT'}{$_}, $txt); - } -} - -########## -### perform commands. -### - -# Usage: &performReply($reply); -sub performReply { - my ($reply) = @_; - - if (!defined $reply or $reply =~ /^\s*$/) { - &DEBUG("performReply: reply == NULL."); - return; - } - - $reply =~ /([\.\?\s]+)$/; - - # FIXME need real throttling.... - if (length($reply) > $maxlinelen - 30) { - $reply = substr($reply, 0, $maxlinelen - 33); - $reply =~ s/ [^ ]*?$/ .../; - } - &checkMsgType($reply); - - if ($msgType eq 'public') { - if (rand() < 0.5 or $reply =~ /[\.\?]$/) { - $reply = "$orig{who}: ".$reply; - } else { - $reply = "$reply, ".$orig{who}; - } - &say($reply); - - } elsif ($msgType eq 'private') { - if (rand() > 0.5) { - $reply = "$reply, ".$orig{who}; - } - &msg($who, $reply); - - } elsif ($msgType eq 'chat') { - if (!exists $dcc{'CHAT'}{$who}) { - &VERB("pSR: dcc{'CHAT'}{$who} does not exist.",2); - return; - } - $conn->privmsg($dcc{'CHAT'}{$who}, $reply); - - } else { - &ERROR("PR: msgType invalid? ($msgType)."); - } -} - -# ... -sub performAddressedReply { - return unless ($addressed); - &performReply(@_); -} - -# Usage: &performStrictReply($reply); -sub performStrictReply { - my ($reply) = @_; - - # FIXME need real throttling.... - if (length($reply) > $maxlinelen - 30) { - $reply = substr($reply, 0, $maxlinelen - 33); - $reply =~ s/ [^ ]*?$/ .../; - } - &checkMsgType($reply); - - if ($msgType eq 'private') { - &msg($who, $reply); - } elsif ($msgType eq 'public') { - &say($reply); - } elsif ($msgType eq 'chat') { - &dccsay(lc $who, $reply); - } else { - &ERROR("pSR: msgType invalid? ($msgType)."); - } -} - -sub dccsay { - my($who, $reply) = @_; - - if (!defined $reply or $reply =~ /^\s*$/) { - &WARN("dccsay: reply == NULL."); - return; - } - - if (!exists $dcc{'CHAT'}{$who}) { - &VERB("pSR: dcc{'CHAT'}{$who} does not exist. (2)",2); - return; - } - - &status("=>$who<= $reply"); # dcc chat. - $conn->privmsg($dcc{'CHAT'}{$who}, $reply); -} - -sub dcc_close { - my($who) = @_; - my $type; - - foreach $type (keys %dcc) { - &FIXME("dcc_close: $who"); - my @who = grep /^\Q$who\E$/i, keys %{ $dcc{$type} }; - next unless (scalar @who); - $who = $who[0]; - &DEBUG("dcc_close... close $who!"); - } -} - -sub joinchan { - my ($chan, $key) = @_; - $key ||= &getChanConf('chankey', $chan); - $key ||= ''; - - # forgot for about 2 years to implement channel keys when moving - # over to Net::IRC... - - # hopefully validChan is right. - if (&validChan($chan)) { - &status("join: already on $chan?"); - } - #} else { - &status("joining $b_blue$chan $key$ob"); - - return if ($conn->join($chan, $key)); - return if (&validChan($chan)); - - &DEBUG("joinchan: join failed. trying connect!"); - &clearIRCVars(); - $conn->connect(); - #} -} - -sub part { - my $chan; - - foreach $chan (@_) { - next if ($chan eq ''); - $chan =~ tr/A-Z/a-z/; # lowercase. - - if ($chan !~ /^$mask{chan}$/) { - &WARN("part: chan is invalid ($chan)"); - next; - } - - &status("parting $chan"); - if (!&validChan($chan)) { - &WARN("part: not on $chan; doing anyway"); -# next; - } - - $conn->part($chan); - # deletion of $channels{chan} is done in &entryEvt(). - } -} - -sub mode { - my ($chan, @modes) = @_; - my $modes = join(" ", @modes); - - if (&validChan($chan) == 0) { - &ERROR("mode: invalid chan => '$chan'."); - return; - } - - &DEBUG("mode: MODE $chan $modes"); - - # should move to use Net::IRC's $conn->mode()... but too lazy. - rawout("MODE $chan $modes"); -} - -sub op { - my ($chan, @who) = @_; - my $os = 'o' x scalar(@who); - - &mode($chan, "+$os @who"); -} - -sub deop { - my ($chan, @who) = @_; - my $os = 'o' x scalar(@who); - - &mode($chan, "-$os ".@who); -} - -sub kick { - my ($nick,$chan,$msg) = @_; - my (@chans) = ($chan eq '') ? (keys %channels) : lc($chan); - my $mynick = $conn->nick(); - - if ($chan ne '' and &validChan($chan) == 0) { - &ERROR("kick: invalid channel $chan."); - return; - } - - $nick =~ tr/A-Z/a-z/; - - foreach $chan (@chans) { - if (!&IsNickInChan($nick,$chan)) { - &status("kick: $nick is not on $chan.") if (scalar @chans == 1); - next; - } - - if (!exists $channels{$chan}{o}{$mynick}) { - &status("kick: do not have ops on $chan :("); - next; - } - - &status("Kicking $nick from $chan."); - $conn->kick($chan, $nick, $msg); - } -} - -sub ban { - my ($mask,$chan) = @_; - my (@chans) = ($chan =~ /^\*?$/) ? (keys %channels) : lc($chan); - my $mynick = $conn->nick(); - my $ban = 0; - - if ($chan !~ /^\*?$/ and &validChan($chan) == 0) { - &ERROR("ban: invalid channel $chan."); - return; - } - - foreach $chan (@chans) { - if (!exists $channels{$chan}{o}{$mynick}) { - &status("ban: do not have ops on $chan :("); - next; - } - - &status("Banning $mask from $chan."); - &rawout("MODE $chan +b $mask"); - $ban++; - } - - return $ban; -} - -sub unban { - my ($mask,$chan) = @_; - my (@chans) = ($chan =~ /^\*?$/) ? (keys %channels) : lc($chan); - my $mynick = $conn->nick(); - my $ban = 0; - - &DEBUG("unban: mask = $mask, chan = @chans"); - - foreach $chan (@chans) { - if (!exists $channels{$chan}{o}{$mynick}) { - &status("unBan: do not have ops on $chan :("); - next; - } - - &status("Removed ban $mask from $chan."); - &rawout("MODE $chan -b $mask"); - $ban++; - } - - return $ban; -} - -sub quit { - my ($quitmsg) = @_; - if (defined $conn) { - &status("QUIT " . $conn->nick() . " has quit IRC ($quitmsg)"); - $conn->quit($quitmsg); - } else { - &WARN("quit: could not quit!"); - } -} - -sub nick { - my ($newnick) = @_; - my $mynick = $conn->nick(); - - if (!defined $newnick) { - &ERROR("nick: nick == NULL."); - return; - } - - if (!defined $mynick) { - &WARN("nick: mynick == NULL."); - return; - } - - my $bad = 0; - $bad++ if (exists $nuh{$newnick}); - $bad++ if (&IsNickInAnyChan($newnick)); - - if ($bad) { - &WARN("Nick: not going to try to change from $mynick to $newnick. [". scalar(gmtime). "]"); - # hrm... over time we lose track of our own nick. - #return; - } - - if ($newnick =~ /^$mask{nick}$/) { - &status("nick: Changing nick from $mynick to $newnick"); - # ->nick() will NOT change cause we are using rawout? - &rawout("NICK $newnick"); - return 1; - } - &DEBUG("nick: failed... why oh why (mynick=$mynick, newnick=$newnick)"); - return 0; -} - -sub invite { - my($who, $chan) = @_; - # TODO: check if $who or $chan are invalid. - - $conn->invite($who, $chan); -} - -########## -# Channel related functions... -# - -# Usage: &joinNextChan(); -sub joinNextChan { - my $joined = 0; - foreach (sort keys %conns) { - $conn = $conns{$_}; - my $mynick = $conn->nick(); - my @join = getJoinChans(1); - - if (scalar @join) { - my $chan = shift @join; - &joinchan($chan); - - if (my $i = scalar @join) { - &status("joinNextChan: $mynick $i chans to join."); - } - $joined = 1; - } - } - return if $joined; - - if (exists $cache{joinTime}) { - my $delta = time() - $cache{joinTime} - 5; - my $timestr = &Time2String($delta); - # FIXME: @join should be @in instead (hacked to 10) - #my $rate = sprintf("%.1f", $delta / @in); - my $rate = sprintf("%.1f", $delta / 10); - delete $cache{joinTime}; - - &status("time taken to join all chans: $timestr; rate: $rate sec/join"); - } - - # chanserv check: global channels, in case we missed one. - foreach ( &ChanConfList('chanServ_ops') ) { - &chanServCheck($_); - } -} - -# Usage: &getNickInChans($nick); -sub getNickInChans { - my ($nick) = @_; - my @array; - - foreach (keys %channels) { - next unless (grep /^\Q$nick\E$/i, keys %{ $channels{$_}{''} }); - push(@array, $_); - } - - return @array; -} - -# Usage: &getNicksInChan($chan); -sub getNicksInChan { - my ($chan) = @_; - my @array; - - return keys %{ $channels{$chan}{''} }; -} - -sub IsNickInChan { - my ($nick,$chan) = @_; - - $chan =~ tr/A-Z/a-z/; # not lowercase unfortunately. - - if ($chan =~ /^$/) { - &DEBUG("INIC: chan == NULL."); - return 0; - } - - if (&validChan($chan) == 0) { - &ERROR("INIC: invalid channel $chan."); - return 0; - } - - if (grep /^\Q$nick\E$/i, keys %{ $channels{$chan}{''} }) { - return 1; - } else { - foreach (keys %channels) { - next unless (/[A-Z]/); - &DEBUG("iNIC: hash channels contains mixed cased chan!!!"); - } - return 0; - } -} - -sub IsNickInAnyChan { - my ($nick) = @_; - my $chan; - - foreach $chan (keys %channels) { - next unless (grep /^\Q$nick\E$/i, keys %{ $channels{$chan}{''} }); - return 1; - } - return 0; -} - -# Usage: &validChan($chan); -sub validChan { - # TODO: use $c instead? - my ($chan) = @_; - - if (!defined $chan or $chan =~ /^\s*$/) { - return 0; - } - - if (lc $chan ne $chan) { - &WARN("validChan: lc chan != chan. ($chan); fixing."); - $chan =~ tr/A-Z/a-z/; - } - - # it's possible that this check creates the hash if empty. - if (defined $channels{$chan} or exists $channels{$chan}) { - if ($chan =~ /^_?default$/) { -# &WARN("validC: chan cannot be _default! returning 0!"); - return 0; - } - - return 1; - } else { - return 0; - } -} - -### -# Usage: &delUserInfo($nick,@chans); -sub delUserInfo { - my ($nick,@chans) = @_; - my ($mode,$chan); - - foreach $chan (@chans) { - foreach $mode (keys %{ $channels{$chan} }) { - # use grep here? - next unless (exists $channels{$chan}{$mode}{$nick}); - - delete $channels{$chan}{$mode}{$nick}; - } - } -} - -sub clearChanVars { - my ($chan) = @_; - - delete $channels{$chan}; -} - -sub clearIRCVars { - undef %channels; - undef %floodjoin; - - $cache{joinTime} = time(); -} - -sub getJoinChans { - my($show) = @_; - - my @in; - my @skip; - my @join; - - # can't join any if not connected - return @join if (!$conn); - - my $nick = $conn->nick(); - - foreach (keys %chanconf) { - next if ($_ eq '_default'); - - my $skip = 0; - my $val = $chanconf{$_}{autojoin}; - - if (defined $val) { - $skip++ if ($val eq '0'); - if ($val eq '1') { - # convert old +autojoin to autojoin - $val = lc $nick; - $chanconf{$_}{autojoin} = $val; - } - $skip++ if (lc $val ne lc $nick); - } else { - $skip++; - } - - if ($skip) { - push(@skip, $_); - } else { - if (defined $channels{$_} or exists $channels{$_}) { - push(@in, $_); - } else { - push(@join, $_); - } - } - } - - my $str; - #$str .= ' in:' . join(',', sort @in) if scalar @in; - #$str .= ' skip:' . join(',', sort @skip) if scalar @skip; - $str .= ' join:' . join(',', sort @join) if scalar @join; - - &status("Chans: ($nick)$str") if ($show); - - return sort @join; -} - -sub closeDCC { -# &DEBUG("closeDCC called."); - my $type; - - foreach $type (keys %dcc) { - next if ($type ne uc($type)); - - my $nick; - foreach $nick (keys %{ $dcc{$type} }) { - next unless (defined $nick); - &status("DCC CHAT: closing DCC $type to $nick."); - next unless (defined $dcc{$type}{$nick}); - - my $ref = $dcc{$type}{$nick}; - &dccsay($nick, "bye bye, $nick") if ($type =~ /^chat$/i); - $dcc{$type}{$nick}->close(); - delete $dcc{$type}{$nick}; - &DEBUG("after close for $nick"); - } - delete $dcc{$type}; - } -} - -sub joinfloodCheck { - my($who,$chan,$userhost) = @_; - - return unless (&IsChanConf('joinfloodCheck') > 0); - - if (exists $netsplit{lc $who}) { # netsplit join. - &DEBUG("joinfloodCheck: $who was in netsplit; not checking."); - } - - if (exists $floodjoin{$chan}{$who}{Time}) { - &WARN("floodjoin{$chan}{$who} already exists?"); - } - - $floodjoin{$chan}{$who}{Time} = time(); - $floodjoin{$chan}{$who}{Host} = $userhost; - - ### Check... - foreach (keys %floodjoin) { - my $c = $_; - my $count = scalar keys %{ $floodjoin{$c} }; - next unless ($count > 5); - &DEBUG("joinflood: count => $count"); - - my $time; - foreach (keys %{ $floodjoin{$c} }) { - my $t = $floodjoin{$c}{$_}{Time}; - next unless (defined $t); - - $time += $t; - } - &DEBUG("joinflood: time => $time"); - $time /= $count; - - &DEBUG("joinflood: new time => $time"); - } - - ### Clean it up. - my $delete = 0; - my $time = time(); - foreach $chan (keys %floodjoin) { - foreach $who (keys %{ $floodjoin{$chan} }) { - my $t = $floodjoin{$chan}{$who}{Time}; - next unless (defined $t); - - my $delta = $time - $t; - next unless ($delta > 10); - - delete $floodjoin{$chan}{$who}; - $delete++; - } - } - - &DEBUG("joinfloodCheck: $delete deleted.") if ($delete); -} - -sub getHostMask { - my($n) = @_; - - if (exists $nuh{$n}) { - return &makeHostMask($nuh{$n}); - } else { - $cache{on_who_Hack} = 1; - $conn->who($n); - } -} - -1; diff --git a/blootbot/src/IRC/IrcHelpers.pl b/blootbot/src/IRC/IrcHelpers.pl deleted file mode 100644 index e45b4b7..0000000 --- a/blootbot/src/IRC/IrcHelpers.pl +++ /dev/null @@ -1,385 +0,0 @@ -# -# IrcHooks.pl: IRC Hooks stuff. -# Author: dms -# Version: 20010413 -# Created: 20010413 -# NOTE: Based on code by Kevin Lenzo & Patrick Cole (c) 1997 -# - -####################################################################### -####### IRC HOOK HELPERS IRC HOOK HELPERS IRC HOOK HELPERS ######## -####################################################################### - -##### -# Usage: &hookMode($nick, $modes, @targets); -sub hookMode { - my ($nick, $modes, @targets) = @_; - my $parity = 0; - - if ($chan =~ tr/A-Z/a-z/) { - &VERB("hookMode: cased $chan.",2); - } - - my $mode; - foreach $mode (split(//, $modes)) { - # sign. - if ($mode =~ /[-+]/) { - $parity = 1 if ($mode eq "+"); - $parity = 0 if ($mode eq "-"); - next; - } - - # mode with target. - if ($mode =~ /[bklov]/) { - my $target = shift @targets; - - if ($parity) { - $chanstats{$chan}{'Op'}++ if ($mode eq 'o'); - $chanstats{$chan}{'Ban'}++ if ($mode eq 'b'); - } else { - $chanstats{$chan}{'Deop'}++ if ($mode eq 'o'); - $chanstats{$chan}{'Unban'}++ if ($mode eq 'b'); - } - - # modes w/ target affecting nick => cache it. - if ($mode =~ /[bov]/) { - $channels{$chan}{$mode}{$target}++ if $parity; - delete $channels{$chan}{$mode}{$target} if !$parity; - - # lets do some custom stuff. - if ($mode eq 'o' and $parity) { - if ($nick eq 'ChanServ' and $target =~ /^\Q$ident\E$/i) { - &VERB("hookmode: chanserv deopped us! asking",2); - &chanServCheck($chan); - } - - &chanLimitVerify($chan); - } - } - - if ($mode =~ /[l]/) { - $channels{$chan}{$mode} = $target if $parity; - delete $channels{$chan}{$mode} if !$parity; - } - } - - # important channel modes, targetless. - if ($mode =~ /[mt]/) { - $channels{$chan}{$mode}++ if $parity; - delete $channels{$chan}{$mode} if !$parity; - } - } -} - -sub hookMsg { - ($msgType, $chan, $who, $message) = @_; - my $skipmessage = 0; - $addressed = 0; - $addressedother = 0; - $orig{message} = $message; - $orig{who} = $who; - $addrchar = 0; - - $message =~ s/[\cA-\c_]//ig; # strip control characters - $message =~ s/^\s+//; # initial whitespaces. - $who =~ tr/A-Z/a-z/; # lowercase. - my $mynick = $conn->nick(); - - &showProc(); - - # addressing. - if ($msgType =~ /private/) { - # private messages. - $addressed = 1; - if (&IsChanConf('addressCharacter') > 0) { - $addressCharacter = getChanConf('addressCharacter'); - if ($message =~ s/^\Q$addressCharacter\E//) { - &msg($who, "The addressCharacter \"$addressCharacter\" is to get my attention in a normal channel. Please leave it off when messaging me directly."); - } - } - } else { - # public messages. - # addressing revamped by the xk. - ### below needs to be fixed... - if (&IsChanConf('addressCharacter') > 0) { - $addressCharacter = getChanConf('addressCharacter'); - if ($message =~ s/^\Q$addressCharacter\E//) { - $addrchar = 1; - $addressed = 1; - } - } - - if ($message =~ /^($mask{nick})([\;\:\>\, ]+) */) { - my $newmessage = $'; - if ($1 =~ /^\Q$mynick\E$/i) { - $message = $newmessage; - $addressed = 1; - } else { - # ignore messages addressed to other people or unaddressed. - $skipmessage++ if ($2 ne '' and $2 !~ /^ /); - } - } - } - - # Determine floodwho. - my $c = '_default'; - if ($msgType =~ /public/i) { - # public. - $floodwho = $c = lc $chan; - } elsif ($msgType =~ /private/i) { - # private. - $floodwho = lc $who; - } else { - # dcc? - &FIXME("floodwho = ???"); - } - - my $val = &getChanConfDefault('floodRepeat', "2:5", $c); - my ($count, $interval) = split /:/, $val; - - # flood repeat protection. - if ($addressed) { - my $time = $flood{$floodwho}{$message} || 0; - - if (!&IsFlag('o') and $msgType eq 'public' and (time() - $time < $interval)) { - ### public != personal who so the below is kind of pointless. - my @who; - foreach (keys %flood) { - next if (/^\Q$floodwho\E$/); - next if (defined $chan and /^\Q$chan\E$/); - - push(@who, grep /^\Q$message\E$/i, keys %{ $flood{$_} }); - } - - return if ($lobotomized); - - if (!scalar @who) { - push(@who,'Someone'); - } - &msg($who,join(' ', @who)." already said that ". (time - $time) ." seconds ago" ); - - ### TODO: delete old floodwarn{} keys. - my $floodwarn = 0; - if (!exists $floodwarn{$floodwho}) { - $floodwarn++; - } else { - $floodwarn++ if (time() - $floodwarn{$floodwho} > $interval); - } - - if ($floodwarn) { - &status("FLOOD repetition detected from $floodwho."); - $floodwarn{$floodwho} = time(); - } - - return; - } - - if ($addrchar) { - &status("$b_cyan$who$ob is short-addressing $mynick"); - } elsif ($msgType eq 'private') { # private. - &status("$b_cyan$who$ob is /msg'ing $mynick"); - } else { # public? - &status("$b_cyan$who$ob is addressing $mynick"); - } - - $flood{$floodwho}{$message} = time(); - } elsif ($msgType eq 'public' and &IsChanConf('kickOnRepeat') > 0) { - # unaddressed, public only. - - ### TODO: use a separate "short-time" hash. - my @data; - @data = keys %{ $flood{$floodwho} } if (exists $flood{$floodwho}); - } - - $val = &getChanConfDefault('floodMessages', "5:30", $c); - ($count, $interval) = split /:/, $val; - - # flood overflow protection. - if ($addressed) { - foreach (keys %{ $flood{$floodwho} }) { - next unless (time() - $flood{$floodwho}{$_} > $interval); - delete $flood{$floodwho}{$_}; - } - - my $i = scalar keys %{ $flood{$floodwho} }; - if ($i > $count) { - my $expire = $param{'ignoreAutoExpire'} || 5; - -# &msg($who,"overflow of messages ($i > $count)"); - &msg($who,"Too many queries from you, ignoring for $expire minutes."); - &status("FLOOD overflow detected from $floodwho; ignoring"); - - &ignoreAdd("*!$uh", $chan, $expire, "flood overflow auto-detected."); - return; - } - - $flood{$floodwho}{$message} = time(); - } - - my @ignore; - if ($msgType =~ /public/i) { # public. - $talkchannel = $chan; - &status("<$orig{who}/$chan> $orig{message}"); - push(@ignore, keys %{ $ignore{$chan} }) if (exists $ignore{$chan}); - } elsif ($msgType =~ /private/i) { # private. - &status("[$orig{who}] $orig{message}"); - $talkchannel = undef; - $chan = '_default'; - } else { - &DEBUG("unknown msgType => $msgType."); - } - push(@ignore, keys %{ $ignore{'*'} }) if (exists $ignore{'*'}); - - if ((!$skipmessage or &IsChanConf('seenStoreAll') > 0) and - &IsChanConf('sed') > 0 and &IsChanConf('seen') > 0 and - $msgType =~ /public/ and - $orig{message} =~ /^s\/([^;\/]*)\/([^;\/]*)\/([g]*)$/) { - my $sedmsg = $seencache{$who}{'msg'}; - eval "\$sedmsg =~ s/\Q$1\E/\Q$2\E/$3;"; - $sedmsg =~ s/^(.{255}).*$/$1.../; # 255 char max to prevent flood - - if ($sedmsg ne $seencache{$who}{'msg'}) { - &DEBUG("sed \"" . $orig{message} . "\" \"" . - $seencache{$who}{'msg'} . "\" \"" . $sedmsg. "\""); - &msg($talkchannel, "$orig{who} meant: $sedmsg"); - } - } elsif ((!$skipmessage or &IsChanConf('seenStoreAll') > 0) and - &IsChanConf('seen') > 0 and $msgType =~ /public/) { - $seencache{$who}{'time'} = time(); - $seencache{$who}{'nick'} = $orig{who}; - $seencache{$who}{'host'} = $uh; - $seencache{$who}{'chan'} = $talkchannel; - $seencache{$who}{'msg'} = $orig{message}; - $seencache{$who}{'msgcount'}++; - } - if (&IsChanConf('minVolunteerLength') > 0) { - # FIXME hack to treat unaddressed as if using addrchar - $addrchar = 1; - } - return if ($skipmessage); - return unless ($addrchar or $addressed); - - foreach (@ignore) { - s/\*/\\S*/g; - - next unless (eval { $nuh =~ /^$_$/i } ); - - # better to ignore an extra message than to allow one to get - # through, although it would be better to go through ignore - # checking again. - if (time() - ($cache{ignoreCheckTime} || 0) > 60) { - &ignoreCheck(); - } - - &status("IGNORE <$who> $message"); - return; - } - - if (defined $nuh) { - if (!defined $userHandle) { - &DEBUG("line 1074: need verifyUser?"); - &verifyUser($who, $nuh); - } - } else { - &DEBUG("hookMsg: 'nuh' not defined?"); - } - -### For extra debugging purposes... - if ($_ = &process()) { -# &DEBUG("IrcHooks: process returned '$_'."); - } - - # hack to remove +o from ppl with +O flag. - if (exists $users{$userHandle} && exists $users{$userHandle}{FLAGS} && - $users{$userHandle}{FLAGS} =~ /O/ - ) { - $users{$userHandle}{FLAGS} =~ s/o//g; - } - - return; -} - -# this is basically run on on_join or on_quit -sub chanLimitVerify { - my($c) = @_; - $chan = $c; - my $l = $channels{$chan}{'l'}; - - return unless (&IsChanConf('chanlimitcheck') > 0); - - if (scalar keys %netsplit) { - &WARN("clV: netsplit active (1, chan = $chan); skipping."); - return; - } - - if (!defined $l) { - &DEBUG("$chan: running chanlimitCheck from chanLimitVerify."); - &chanlimitCheck(); - return; - } - - # only change it if it's not set. - my $plus = &getChanConfDefault('chanlimitcheckPlus', 5, $chan); - my $count = scalar(keys %{ $channels{$chan}{''} }); - my $int = &getChanConfDefault('chanlimitcheckInterval', 10, $chan); - - my $delta = $count + $plus - $l; -# $delta =~ s/^\-//; - - if ($plus <= 3) { - &WARN("clc: stupid to have plus at $plus, fix it!"); - } - - if (exists $cache{chanlimitChange}{$chan}) { - if (time() - $cache{chanlimitChange}{$chan} < $int*60) { - return; - } - } - - &chanServCheck($chan); - - ### TODO: unify code with chanlimitcheck() - return if ($delta > 5); - - &status("clc: big change in limit for $chan ($delta);". - "going for it. (was: $l; now: ".($count+$plus).")"); - - $conn->mode($chan, "+l", $count+$plus); - $cache{chanlimitChange}{$chan} = time(); -} - -sub chanServCheck { - ($chan) = @_; - - if (!defined $chan or $chan =~ /^\s*$/) { - &WARN("chanServCheck: chan == NULL."); - return 0; - } - - if ($chan =~ tr/A-Z/a-z/) { - &DEBUG("chanServCheck: lowercased chan ($chan)"); - } - - if (! &IsChanConf('chanServ_ops') > 0) { - return 0; - } - - &VERB("chanServCheck($chan) called.",2); - - if ( &IsParam('nickServ_pass') and !$nickserv) { - $conn->who('NickServ'); - return 0; - } - - # check for first hash then for next hash. - # TODO: a function for &ischanop()? &isvoice()? - if (exists $channels{$chan} and exists $channels{$chan}{'o'}{$ident}) { - return 0; - } - - &status("ChanServ ==> Requesting ops for $chan. (chanServCheck)"); - &rawout("PRIVMSG ChanServ :OP $chan $ident"); - return 1; -} - -1; diff --git a/blootbot/src/IRC/IrcHooks.pl b/blootbot/src/IRC/IrcHooks.pl deleted file mode 100644 index cf873ce..0000000 --- a/blootbot/src/IRC/IrcHooks.pl +++ /dev/null @@ -1,1281 +0,0 @@ -# -# IrcHooks.pl: IRC Hooks stuff. -# Author: dms -# Version: 20000126 -# NOTE: Based on code by Kevin Lenzo & Patrick Cole (c) 1997 -# -use vars qw(%chanconf); - -# GENERIC. TO COPY. -sub on_generic { - $conn = shift(@_); - my ($event) = @_; - my $nick = $event->nick(); - my $chan = ($event->to)[0]; - - &DEBUG("on_generic: nick => '$nick'."); - &DEBUG("on_generic: chan => '$chan'."); - - foreach ($event->args) { - &DEBUG("on_generic: args => '$_'."); - } -} - -sub on_action { - $conn = shift(@_); - my ($event) = @_; - my ($nick, @args) = ($event->nick, $event->args); - my $chan = ($event->to)[0]; - - shift @args; - - if ($chan eq $ident) { - &status("* [$nick] @args"); - } else { - &status("* $nick/$chan @args"); - } -} - -sub on_chat { - $conn = shift(@_); - my ($event) = @_; - my $msg = ($event->args)[0]; - my $sock = ($event->to)[0]; - my $nick = lc $event->nick(); - - if (!exists $nuh{$nick}) { - &DEBUG("chat: nuh{$nick} doesn't exist; trying WHOIS ."); - $conn->whois($nick); - return; - } - - ### set vars that would have been set in hookMsg. - $userHandle = ''; # reset. - $who = lc $nick; - $message = $msg; - $orig{who} = $nick; - $orig{message} = $msg; - $nuh = $nuh{$who}; - $uh = (split /\!/, $nuh)[1]; - $h = (split /\@/, $uh)[1]; - $addressed = 1; - $msgType = 'chat'; - - if (!exists $dcc{'CHATvrfy'}{$nick}) { - $userHandle = &verifyUser($who, $nuh); - my $crypto = $users{$userHandle}{PASS}; - my $success = 0; - - if ($userHandle eq '_default') { - &WARN("DCC CHAT: _default/guest not allowed."); - return; - } - - ### TODO: prevent users without CRYPT chatting. - if (!defined $crypto) { - &TODO("dcc close chat"); - &msg($who, "nope, no guest logins allowed..."); - return; - } - - if (&ckpasswd($msg, $crypto)) { - # stolen from eggdrop. - $conn->privmsg($sock, "Connected to $ident"); - $conn->privmsg($sock, "Commands start with '.' (like '.quit' or '.help')"); - $conn->privmsg($sock, "Everything else goes out to the party line."); - - &dccStatus(2) unless (exists $sched{'dccStatus'}{RUNNING}); - - $success++; - - } else { - &status("DCC CHAT: incorrect pass; closing connection."); - &DEBUG("chat: sock => '$sock'."); -### $sock->close(); - delete $dcc{'CHAT'}{$nick}; - &FIXME("chat: after closing sock."); - ### BUG: close seizes bot. why? - } - - if ($success) { - &status("DCC CHAT: user $nick is here!"); - &DCCBroadcast("*** $nick ($uh) joined the party line."); - - $dcc{'CHATvrfy'}{$nick} = $userHandle; - - return if ($userHandle eq '_default'); - - &dccsay($nick,"Flags: $users{$userHandle}{FLAGS}"); - } - - return; - } - - &status("$b_red=$b_cyan$who$b_red=$ob $message"); - - if ($message =~ s/^\.//) { # dcc chat commands. - ### TODO: make use of &Forker(); here? - &loadMyModule('UserDCC'); - - &DCCBroadcast("#$who# $message",'m'); - - my $retval = &userDCC(); - return unless (defined $retval); - return if ($retval eq $noreply); - - $conn->privmsg($dcc{'CHAT'}{$who}, "Invalid command."); - - } else { # dcc chat arena. - - foreach (keys %{ $dcc{'CHAT'} }) { - $conn->privmsg($dcc{'CHAT'}{$_}, "<$who> $orig{message}"); - } - } - - return 'DCC CHAT MESSAGE'; -} - -# is there isoff? how do we know if someone signs off? -sub on_ison { - $conn = shift(@_); - my ($event) = @_; - my $x1 = ($event->args)[0]; - my $x2 = ($event->args)[1]; - $x2 =~ s/\s$//; - - &DEBUG("on_ison: x1 = '$x1', x2 => '$x2'"); -} - -sub on_endofmotd { - $conn = shift(@_); - - # update IRCStats. - $ident = $conn->nick(); - $ircstats{'ConnectTime'} = time(); - $ircstats{'ConnectCount'}++; - if (defined $ircstats{'DisconnectTime'}) { - $ircstats{'OffTime'} += time() - $ircstats{'DisconnectTime'}; - } - - # first time run. - if (!exists $users{_default}) { - &status("!!! First time run... adding _default user."); - $users{_default}{FLAGS} = 'amrt'; - $users{_default}{HOSTS}{"*!*@*"} = 1; - } - - if (scalar keys %users < 2) { - &status("!"x40); - &status("!!! Ok. Now type '/msg $ident PASS ' to get master access through DCC CHAT."); - &status("!"x40); - } - # end of first time run. - - if (&IsChanConf('Wingate') > 0) { - my $file = "$bot_base_dir/$param{'ircUser'}.wingate"; - open(IN, $file); - while () { - chop; - next unless (/^(\S+)\*$/); - push(@wingateBad, $_); - } - close IN; - } - - if ($firsttime) { - &ScheduleThis(1, 'setupSchedulers'); - $firsttime = 0; - } - - if (&IsParam('ircUMode')) { - &VERB("Attempting change of user modes to $param{'ircUMode'}.", 2); - if ($param{'ircUMode'} !~ /^[-+]/) { - &WARN("ircUMode had no +- prefix; adding +"); - $param{'ircUMode'} = "+".$param{'ircUMode'}; - } - - &rawout("MODE $ident $param{'ircUMode'}"); - } - - # ok, we're free to do whatever we want now. go for it! - $running = 1; - - # add ourself to notify. - $conn->ison($conn->nick()); - - # Q, as on quakenet.org. - if (&IsParam('Q_pass')) { - &status("Authing to Q..."); - &rawout("PRIVMSG Q\@CServe.quakenet.org :AUTH $param{'Q_user'} $param{'Q_pass'}"); - } - - &status("End of motd. Now lets join some channels..."); - #&joinNextChan(); -} - -sub on_endofwho { - $conn = shift(@_); - my ($event) = @_; -# &DEBUG("endofwho: chan => $chan"); - $chan ||= ($event->args)[1]; -# &DEBUG("endofwho: chan => $chan"); - - if (exists $cache{countryStats}) { - &do_countrystats(); - } -} - -sub on_dcc { - $conn = shift(@_); - my ($event) = @_; - my $type = uc( ($event->args)[1] ); - my $nick = lc $event->nick(); - - &status("on_dcc type=$type nick=$nick sock=$sock"); - - # pity Net::IRC doesn't store nuh. Here's a hack :) - if (!exists $nuh{lc $nick}) { - $conn->whois($nick); - $nuh{$nick} = "GETTING-NOW"; # trying. - } - $type ||= "???"; - - if ($type eq 'SEND') { # GET for us. - # incoming DCC SEND. we're receiving a file. - my $get = ($event->args)[2]; - &status("DCC: not Initializing GET from $nick to '$param{tempDir}/$get'"); - # FIXME: do we want to get anything? - return; - #open(DCCGET,">$param{tempDir}/$get"); - #$conn->new_get($event, \*DCCGET); - - } elsif ($type eq 'GET') { # SEND for us? - &status("DCC: not Initializing SEND for $nick."); - # FIXME: do we want to do anything? - return; - $conn->new_send($event->args); - - } elsif ($type eq 'CHAT') { - &status("DCC: Initializing CHAT for $nick."); - $conn->new_chat($event); -# $conn->new_chat(1, $nick, $event->host); - - } else { - &WARN("${b_green}DCC $type$ob (1)"); - } -} - -sub on_dcc_close { - $conn = shift(@_); - my ($event) = @_; - my $nick = $event->nick(); - my $sock = ($event->to)[0]; - - # DCC CHAT close on fork exit workaround. - if ($bot_pid != $$) { - &WARN("run-away fork; exiting."); - &delForked($forker); - } - - if (exists $dcc{'SEND'}{$nick} and -f "$param{tempDir}/$nick.txt") { - &status("${b_green}DCC SEND$ob close from $b_cyan$nick$ob"); - - &status("dcc_close: purging DCC send $nick.txt"); - unlink "$param{tempDir}/$nick.txt"; - - delete $dcc{'SEND'}{$nick}; - } elsif (exists $dcc{'CHAT'}{$nick} and $dcc{'CHAT'}{$nick} eq $sock) { - &status("${b_green}DCC CHAT$ob close from $b_cyan$nick$ob"); - delete $dcc{'CHAT'}{$nick}; - delete $dcc{'CHATvrfy'}{$nick}; - } else { - &status("${b_green}DCC$ob UNKNOWN close from $b_cyan$nick$ob (2)"); - } -} - -sub on_dcc_open { - $conn = shift(@_); - my ($event) = @_; - my $type = uc( ($event->args)[0] ); - my $nick = lc $event->nick(); - my $sock = ($event->to)[0]; - - &status("on_dcc_open type=$type nick=$nick sock=$sock"); - - $msgType = 'chat'; - $type ||= "???"; - ### BUG: who is set to bot's nick? - - # lets do it. - if ($type eq 'SEND') { - &status("${b_green}DCC lGET$ob established with $b_cyan$nick$ob"); - - } elsif ($type eq 'CHAT') { - # very cheap hack. - ### TODO: run ScheduleThis inside on_dcc_open_chat recursively - ### 1,3,5,10 seconds then fail. - if ($nuh{$nick} eq "GETTING-NOW") { - &ScheduleThis(3/60, 'on_dcc_open_chat', $nick, $sock); - } else { - on_dcc_open_chat(undef, $nick, $sock); - } - - } elsif ($type eq 'SEND') { - &status("Starting DCC receive."); - foreach ($event->args) { - &status(" => '$_'."); - } - - } else { - &WARN("${b_green}DCC $type$ob (3)"); - } -} - -# really custom sub to get NUH since Net::IRC doesn't appear to support -# it. -sub on_dcc_open_chat { - my(undef, $nick, $sock) = @_; - - if ($nuh{$nick} eq "GETTING-NOW") { - &FIXME("getting nuh for $nick failed."); - return; - } - - &status("${b_green}DCC CHAT$ob established with $b_cyan$nick$ob $b_yellow($ob$nuh{$nick}$b_yellow)$ob"); - - &verifyUser($nick, $nuh{lc $nick}); - - if (!exists $users{$userHandle}{HOSTS}) { - &performStrictReply("you have no hosts defined in my user file; rejecting."); - $sock->close(); - return; - } - - my $crypto = $users{$userHandle}{PASS}; - $dcc{'CHAT'}{$nick} = $sock; - - # TODO: don't make DCC CHAT established in the first place. - if ($userHandle eq '_default') { - &dccsay($nick, "_default/guest not allowed"); - $sock->close(); - return; - } - - if (defined $crypto) { - &status("DCC CHAT: going to use ".$nick."'s crypt."); - &dccsay($nick,"Enter your password."); - } else { -# &dccsay($nick,"Welcome to blootbot DCC CHAT interface, $userHandle."); - } -} - -sub on_disconnect { - $conn = shift(@_); - my ($event) = @_; - my $from = $event->from(); - my $what = ($event->args)[0]; - my $mynick=$conn->nick(); - - &status("$mynick disconnect from $from ($what)."); - $ircstats{'DisconnectTime'} = time(); - $ircstats{'DisconnectReason'} = $what; - $ircstats{'DisconnectCount'}++; - $ircstats{'TotalTime'} += time() - $ircstats{'ConnectTime'} - if ($ircstats{'ConnectTime'}); - - # clear any variables on reconnection. - $nickserv = 0; - - &clearIRCVars(); - - if (!defined $conn) { - &WARN("on_disconnect: self is undefined! WTF"); - &DEBUG("running function irc... lets hope this works."); - &irc(); - return; - } - - &WARN("scheduling call ircCheck() in 60s"); - &clearIRCVars(); - &ScheduleThis(1, 'ircCheck'); -} - -sub on_endofnames { - $conn = shift(@_); - my ($event) = @_; - my $chan = ($event->args)[1]; - - # sync time should be done in on_endofwho like in BitchX - if (exists $cache{jointime}{$chan}) { - my $delta_time = sprintf("%.03f", &timedelta($cache{jointime}{$chan}) ); - $delta_time = 0 if ($delta_time <= 0); - if ($delta_time > 100) { - &WARN("endofnames: delta_time > 100 ($delta_time)"); - } - - &status("$b_blue$chan$ob: sync in ${delta_time}s."); - } - - $conn->mode($chan); - - my $txt; - my @array; - foreach ('o','v','') { - my $count = scalar(keys %{ $channels{$chan}{$_} }); - next unless ($count); - - $txt = 'total' if ($_ eq ''); - $txt = 'voice' if ($_ eq 'v'); - $txt = 'ops' if ($_ eq 'o'); - - push(@array, "$count $txt"); - } - my $chanstats = join(' || ', @array); - &status("$b_blue$chan$ob: [$chanstats]"); - - &chanServCheck($chan); - # schedule used to solve ircu (OPN) "target too fast" problems. - $conn->schedule(5, sub { &joinNextChan(); } ); -} - -sub on_init { - $conn = shift(@_); - my ($event) = @_; - my (@args) = ($event->args); - shift @args; - - &status("@args"); -} - -sub on_invite { - $conn = shift(@_); - my ($event) = @_; - my $chan = lc( ($event->args)[0] ); - my $nick = $event->nick; - - if ($nick =~ /^\Q$ident\E$/) { - &DEBUG("on_invite: self invite."); - return; - } - - ### TODO: join key. - if (exists $chanconf{$chan}) { - # it's still buggy :/ - if (&validChan($chan)) { - &msg($who, "i'm already in \002$chan\002."); -# return; - } - - &status("invited to $b_blue$chan$ob by $b_cyan$nick$ob"); - &joinchan($chan); - } -} - -sub on_join { - $conn = shift(@_); - my ($event) = @_; - my ($user,$host) = split(/\@/, $event->userhost); - $chan = lc( ($event->to)[0] ); # CASING!!!! - $who = $event->nick(); - $msgType = 'public'; - my $i = scalar(keys %{ $channels{$chan} }); - my $j = $cache{maxpeeps}{$chan} || 0; - - if (!&IsParam('noSHM') && time() > ($sched{shmFlush}{TIME} || time()) + 3600) { - &DEBUG("looks like schedulers died somewhere... restarting..."); - &setupSchedulers(); - } - - $chanstats{$chan}{'Join'}++; - $userstats{lc $who}{'Join'} = time() if (&IsChanConf('seenStats') > 0); - $cache{maxpeeps}{$chan} = $i if ($i > $j); - - &joinfloodCheck($who, $chan, $event->userhost); - - # netjoin detection. - my $netsplit = 0; - if (exists $netsplit{lc $who}) { - delete $netsplit{lc $who}; - $netsplit = 1; - - if (!scalar keys %netsplit) { - &DEBUG("on_join: netsplit hash is now empty!"); - undef %netsplitservers; - &netsplitCheck(); # any point in running this? - &chanlimitCheck(); - } - } - - if ($netsplit and !exists $cache{netsplit}) { - &VERB("on_join: ok.... re-running chanlimitCheck in 60.",2); - $conn->schedule(60, sub { - &chanlimitCheck(); - delete $cache{netsplit}; - } ); - - $cache{netsplit} = time(); - } - - # how to tell if there's a netjoin??? - - my $netsplitstr = ''; - $netsplitstr = " $b_yellow\[${ob}NETSPLIT VICTIM$b_yellow]$ob" if ($netsplit); - &status(">>> join/$b_blue$chan$ob $b_cyan$who$ob $b_yellow($ob$user\@$host$b_yellow)$ob$netsplitstr"); - - $channels{$chan}{''}{$who}++; - $nuh = $who."!".$user."\@".$host; - $nuh{lc $who} = $nuh unless (exists $nuh{lc $who}); - - ### on-join bans. - my @bans; - push(@bans, keys %{ $bans{$chan} }) if (exists $bans{$chan}); - push(@bans, keys %{ $bans{'*'} }) if (exists $bans{'*'}); - - foreach (@bans) { - my $ban = $_; - s/\?/./g; - s/\*/\\S*/g; - my $mask = $_; - next unless ($nuh =~ /^$mask$/i); - - ### TODO: check $channels{$chan}{'b'} if ban already exists. - foreach (keys %{ $channels{$chan}{'b'} }) { - &DEBUG(" bans_on_chan($chan) => $_"); - } - - my $reason = "no reason"; - foreach ($chan, '*') { - next unless (exists $bans{$_}); - next unless (exists $bans{$_}{$ban}); - - my @array = @{ $bans{$_}{$ban} }; - - $reason = $array[4] if ($array[4]); - last; - } - - &ban($ban, $chan); - &kick($who, $chan, $reason); - - last; - } - - # no need to go further. - return if ($netsplit); - - # who == bot. - if ($who =~ /^\Q$ident\E$/i) { - if (defined( my $whojoin = $cache{join}{$chan} )) { - &msg($chan, "Okay, I'm here. (courtesy of $whojoin)"); - delete $cache{join}{$chan}; - &joinNextChan(); # hack. - } - - ### TODO: move this to &joinchan()? - $cache{jointime}{$chan} = &timeget(); - $conn->who($chan); - - return; - } - - ### ROOTWARN: - &rootWarn($who,$user,$host,$chan) if ( - &IsChanConf('RootWarn') > 0 && - $user =~ /^~?r(oo|ew|00)t$/i - ); - - ### emit a message based on who just joined - &onjoin($who,$user,$host,$chan) if (&IsChanConf('OnJoin') > 0); - - ### NEWS: - if (&IsChanConf('News') > 0 && &IsChanConf('newsKeepRead') > 0) { - if (!&loadMyModule('News')) { # just in case. - &DEBUG('could not load news.'); - } else { - &News::latest($chan); - } - } - - ### botmail: - if (&IsChanConf('botmail') > 0) { - &botmail::check(lc $who); - } - - ### wingate: - &wingateCheck(); -} - -sub on_kick { - $conn = shift(@_); - my ($event) = @_; - my ($chan,$reason) = $event->args; - my $kicker = $event->nick; - my $kickee = ($event->to)[0]; - my $uh = $event->userhost(); - - &status(">>> kick/$b_blue$chan$ob [$b$kickee!$uh$ob] by $b_cyan$kicker$ob $b_yellow($ob$reason$b_yellow)$ob"); - - $chan = lc $chan; # forgot about this, found by xsdg, 20001229. - $chanstats{$chan}{'Kick'}++; - - if ($kickee eq $ident) { - &clearChanVars($chan); - - &status("SELF attempting to rejoin lost channel $chan"); - &joinchan($chan); - } else { - &delUserInfo($kickee,$chan); - } -} - -sub on_mode { - $conn = shift(@_); - my ($event) = @_; - my ($user, $host) = split(/\@/, $event->userhost); - my @args = $event->args(); - my $nick = $event->nick(); - $chan = ($event->to)[0]; - - # last element is empty... so nuke it. - pop @args while ($args[$#args] eq ''); - - if ($nick eq $chan) { # UMODE - &status(">>> mode $b_yellow\[$ob$b@args$b_yellow\]$ob by $b_cyan$nick$ob"); - } else { # MODE - &status(">>> mode/$b_blue$chan$ob $b_yellow\[$ob$b@args$b_yellow\]$ob by $b_cyan$nick$ob"); - &hookMode($nick, @args); - } -} - -sub on_modeis { - $conn = shift(@_); - my ($event) = @_; - my ($myself, undef,@args) = $event->args(); - my $nick = $event->nick(); - $chan = ($event->args())[1]; - - &hookMode($nick, @args); -} - -sub on_msg { - $conn = shift(@_); - my ($event) = @_; - my $nick = $event->nick; - my $msg = ($event->args)[0]; - - ($user,$host) = split(/\@/, $event->userhost); - $uh = $event->userhost(); - $nuh = $nick."!".$uh; - $msgtime = time(); - $h = $host; - - if ($nick eq $ident) { # hopefully ourselves. - if ($msg eq 'TEST') { - &status("IRCTEST: Yes, we're alive."); - delete $cache{connect}; - return; - } - } - - &hookMsg('private', undef, $nick, $msg); - $who = ''; - $chan = ''; - $msgType = ''; -} - -sub on_names { - $conn = shift(@_); - my ($event) = @_; - my @args = $event->args; - my $chan = lc $args[2]; # CASING, the last of them! - - foreach (split / /, @args[3..$#args]) { - $channels{$chan}{'o'}{$_}++ if s/\@//; - $channels{$chan}{'v'}{$_}++ if s/\+//; - $channels{$chan}{''}{$_}++; - } -} - -sub on_nick { - $conn = shift(@_); - my ($event) = @_; - my $nick = $event->nick(); - my $newnick = ($event->args)[0]; - - if (exists $netsplit{lc $newnick}) { - &status("Netsplit: $newnick/$nick came back from netsplit and changed to original nick! removing from hash."); - delete $netsplit{lc $newnick}; - &netsplitCheck() if (time() != $sched{netsplitCheck}{TIME}); - } - - my ($chan,$mode); - foreach $chan (keys %channels) { - foreach $mode (keys %{ $channels{$chan} }) { - next unless (exists $channels{$chan}{$mode}{$nick}); - - $channels{$chan}{$mode}{$newnick} = $channels{$chan}{$mode}{$nick}; - } - } - # TODO: do %flood* aswell. - - &delUserInfo($nick, keys %channels); - $nuh{lc $newnick} = $nuh{lc $nick}; - delete $nuh{lc $nick}; - - if ($nick eq $conn->nick()) { - &status(">>> I materialized into $b_green$newnick$ob from $nick"); - $ident = $newnick; - $conn->nick($newnick); - } else { - &status(">>> $b_cyan$nick$ob materializes into $b_green$newnick$ob"); - my $mynick=$conn->nick(); - if ($nick =~ /^\Q$mynick\E$/i) { - &getNickInUse(); - } - } -} - -sub on_nick_taken { - $conn = shift(@_); - my $nick = $conn->nick(); - #my $newnick = $nick . int(rand 10); - my $newnick = $nick . '_'; - - &DEBUG("on_nick_taken: nick => $nick"); - - &status("nick taken ($nick); preparing nick change."); - - $conn->whois($nick); - #$conn->schedule(5, sub { - &status("nick taken; changing to temporary nick ($nick -> $newnick)."); - &nick($newnick); - #} ); -} - -sub on_notice { - $conn = shift(@_); - my ($event) = @_; - my $nick = $event->nick(); - my $chan = ($event->to)[0]; - my $args = ($event->args)[0]; - - if ($nick =~ /^NickServ$/i) { # nickserv. - &status("NickServ: <== '$args'"); - - my $check = 0; - $check++ if ($args =~ /^This nickname is registered/i); - $check++ if ($args =~ /nickname.*owned/i); - - if ($check) { - &status("nickserv told us to register; doing it."); - - if (&IsParam('nickServ_pass')) { - &status("NickServ: ==> Identifying."); - &rawout("PRIVMSG NickServ :IDENTIFY $param{'nickServ_pass'}"); - return; - } else { - &status("We can't tell nickserv a passwd ;("); - } - } - - # password accepted. - if ($args =~ /^Password a/i) { - my $done = 0; - - foreach ( &ChanConfList('chanServ_ops') ) { - next unless &chanServCheck($_); - next if ($done); - &DEBUG("nickserv activated or restarted; doing chanserv check."); - $done++; - } - - $nickserv++; - } - - } elsif ($nick =~ /^ChanServ$/i) { # chanserv. - &status("ChanServ: <== '$args'."); - - } else { - if ($chan =~ /^$mask{chan}$/) { # channel notice. - &status("-$nick/$chan- $args"); - } else { - $server = $nick unless (defined $server); - &status("-$nick- $args"); # private or server notice. - } - } -} - -sub on_other { - $conn = shift(@_); - my ($event) = @_; - my $chan = ($event->to)[0]; - my $nick = $event->nick; - - &status("!!! other called."); - &status("!!! $event->args"); -} - -sub on_part { - $conn = shift(@_); - my ($event) = @_; - $chan = lc( ($event->to)[0] ); # CASING!!! - my $mynick = $conn->nick(); - my $nick = $event->nick; - my $userhost = $event->userhost; - $who = $nick; - $msgType = 'public'; - - if (!exists $channels{$chan}) { - &DEBUG("on_part: found out $mynick is on $chan!"); - $channels{$chan} = 1; - } - - if (exists $floodjoin{$chan}{$nick}{Time}) { - delete $floodjoin{$chan}{$nick}; - } - - $chanstats{$chan}{'Part'}++; - &delUserInfo($nick,$chan); - if ($nick eq $ident) { - &clearChanVars($chan); - } - - if (!&IsNickInAnyChan($nick) and &IsChanConf('seenStats') > 0) { - delete $userstats{lc $nick}; - } - - &status(">>> part/$b_blue$chan$ob $b_cyan$nick$ob $b_yellow($ob$userhost$b_yellow)$ob"); -} - -sub on_ping { - $conn = shift(@_); - my ($event) = @_; - my $nick = $event->nick; - - $conn->ctcp_reply($nick, join(' ', ($event->args))); - &status(">>> ${b_green}CTCP PING$ob request from $b_cyan$nick$ob received."); -} - -sub on_ping_reply { - $conn = shift(@_); - my ($event) = @_; - my $nick = $event->nick; - my $t = ($event->args)[1]; - if (!defined $t) { - &WARN("on_ping_reply: t == undefined."); - return; - } - - my $lag = time() - $t; - - &status(">>> ${b_green}CTCP PING$ob reply from $b_cyan$nick$ob: $lag sec."); -} - -sub on_public { - $conn = shift(@_); - my ($event) = @_; - my $msg = ($event->args)[0]; - $chan = lc( ($event->to)[0] ); # CASING. - my $nick = $event->nick; - $who = $nick; - $uh = $event->userhost(); - $nuh = $nick."!".$uh; - $msgType = 'public'; - # TODO: move this out of hookMsg to here? - ($user,$host) = split(/\@/, $uh); - $h = $host; - - # rare case should this happen - catch it just in case. - if ($bot_pid != $$) { - &ERROR("run-away fork; exiting."); - &delForked($forker); - } - - $msgtime = time(); - $lastWho{$chan} = $nick; - ### TODO: use $nick or lc $nick? - if (&IsChanConf('seenStats') > 0) { - $userstats{lc $nick}{'Count'}++; - $userstats{lc $nick}{'Time'} = time(); - } - - # cache it. - my $time = time(); - if (!$cache{ircTextCounters}) { - &DEBUG("caching ircTextCounters for first time."); - my @str = split(/\s+/, &getChanConf('ircTextCounters')); - for (@str) { $_ = quotemeta($_); } - $cache{ircTextCounters} = join('|', @str); - } - - my $str = $cache{ircTextCounters}; - if ($str && $msg =~ /^($str)[\s!\.]?$/i) { - my $x = $1; - - &VERB("textcounters: $x matched for $who",2); - my $c = $chan || 'PRIVATE'; - - # better to do "counter=counter+1". - # but that will avoid time check. - my ($v,$t) = &sqlSelect('stats', "counter,time", { - nick => $who, - type => $x, - channel => $c, - } ); - $v++; - - # don't allow ppl to cheat the stats :-) - if (defined $t && $time - $t > 60) { - &sqlSet('stats', {'nick' => $who}, { - type => $x, - channel => $c, - time => $time, - counter => $v, - } ); - } - } - - &hookMsg('public', $chan, $nick, $msg); - $chanstats{$chan}{'PublicMsg'}++; - $who = ''; - $chan = ''; - $msgType = ''; -} - -sub on_quit { - $conn = shift(@_); - my ($event) = @_; - my $nick = $event->nick(); - my $reason = ($event->args)[0]; - - # hack for ICC. - $msgType = 'public'; - $who = $nick; -### $chan = $reason; # no. - - my $count = 0; - foreach (grep !/^_default$/, keys %channels) { - # fixes inconsistent chanstats bug #1. - if (!&IsNickInChan($nick,$_)) { - $count++; - next; - } - $chanstats{$_}{'SignOff'}++; - } - - if ($count == scalar keys %channels) { - &DEBUG("on_quit: nick $nick was not found in any chan."); - } - - # should fix chanstats inconsistencies bug #2. - if ($reason =~ /^($mask{host})\s($mask{host})$/) { # netsplit. - $reason = "NETSPLIT: $1 <=> $2"; - - # chanlimit code. - foreach $chan ( &getNickInChans($nick) ) { - next unless ( &IsChanConf('chanlimitcheck') > 0); - next unless ( exists $channels{$_}{'l'} ); - - &DEBUG("on_quit: netsplit detected on $_; disabling chan limit."); - $conn->mode($_, "-l"); - } - - $netsplit{lc $nick} = time(); - if (!exists $netsplitservers{$1}{$2}) { - &status("netsplit detected between $1 and $2 at [".scalar(gmtime)."]"); - $netsplitservers{$1}{$2} = time(); - } - } - - my $chans = join(' ', &getNickInChans($nick) ); - &status(">>> $b_cyan$nick$ob has signed off IRC $b_red($ob$reason$b_red)$ob [$chans]"); - - ### - ### ok... lets clear out the cache - ### - &delUserInfo($nick, keys %channels); - if (exists $nuh{lc $nick}) { - delete $nuh{lc $nick}; - } else { - # well.. it's good but weird that this has happened - lets just - # be quiet about it. - } - delete $userstats{lc $nick} if (&IsChanConf('seenStats') > 0); - delete $chanstats{lc $nick}; - ### - - # if we have a temp nick, and whoever is camping on our main nick leaves - # revert to main nick. Note that Net::IRC only knows our main nick - if ($nick eq $conn->nick()) { - &status("nickchange: own nick \"$nick\" became free; changing."); - &nick($mynick); - } -} - -sub on_targettoofast { - $conn = shift(@_); - my ($event) = @_; - my $nick = $event->nick(); - my($me,$chan,$why) = $event->args(); - - ### TODO: incomplete. - if ($why =~ /.* wait (\d+) second/) { - my $sleep = $1; - my $max = 10; - - if ($sleep > $max) { - &status("targettoofast: going to sleep for $max ($sleep)..."); - $sleep = $max; - } else { - &status("targettoofast: going to sleep for $sleep"); - } - - my $delta = time() - ($cache{sleepTime} || 0); - if ($delta > $max+2) { - sleep $sleep; - $cache{sleepTime} = time(); - } - - return; - } - - if (!exists $cache{TargetTooFast}) { - &DEBUG("on_ttf: failed: $why"); - $cache{TargetTooFast}++; - } -} - -sub on_topic { - $conn = shift(@_); - my ($event) = @_; - - if (scalar($event->args) == 1) { # change. - my $topic = ($event->args)[0]; - my $chan = ($event->to)[0]; - my $nick = $event->nick(); - - ### - # WARNING: - # race condition here. To fix, change '1' to '0'. - # This will keep track of topics set by bot only. - ### - # UPDATE: - # this may be fixed at a later date with topic queueing. - ### - - $topic{$chan}{'Current'} = $topic if (1); - $chanstats{$chan}{'Topic'}++; - - &status(">>> topic/$b_blue$chan$ob by $b_cyan$nick$ob -> $topic"); - } else { # join. - my ($nick, $chan, $topic) = $event->args; - if (&IsChanConf('Topic') > 0) { - $topic{$chan}{'Current'} = $topic; - &topicAddHistory($chan,$topic); - } - - $topic = &fixString($topic, 1); - &status(">>> topic/$b_blue$chan$ob is $topic"); - } -} - -sub on_topicinfo { - $conn = shift(@_); - my ($event) = @_; - my ($myself,$chan,$setby,$time) = $event->args(); - - my $timestr; - if (time() - $time > 60*60*24) { - $timestr = "at ". gmtime $time; - } else { - $timestr = &Time2String(time() - $time) ." ago"; - } - - &status(">>> set by $b_cyan$setby$ob $timestr"); -} - -sub on_crversion { - $conn = shift(@_); - my ($event) = @_; - my $nick = $event->nick(); - my $ver; - - if (scalar $event->args() != 1) { # old. - $ver = join ' ', $event->args(); - $ver =~ s/^VERSION //; - } else { # new. - $ver = ($event->args())[0]; - } - - if (grep /^\Q$nick\E$/i, @vernick) { - &WARN("nick $nick found in vernick ($ver); skipping."); - return; - } - push(@vernick, $nick); - - if ($ver =~ /bitchx/i) { - $ver{bitchx}{$nick} = $ver; - - } elsif ($ver =~ /xc\!|xchat/i) { - $ver{xchat}{$nick} = $ver; - - } elsif ($ver =~ /irssi/i) { - $ver{irssi}{$nick} = $ver; - - } elsif ($ver =~ /epic|(Third Eye)/i) { - $ver{epic}{$nick} = $ver; - - } elsif ($ver =~ /ircII|PhoEniX/i) { - $ver{ircII}{$nick} = $ver; - - } elsif ($ver =~ /mirc/i) { -# &DEBUG("verstats: mirc: $nick => '$ver'."); - $ver{mirc}{$nick} = $ver; - -# ok... then we get to the lesser known/used clients. - } elsif ($ver =~ /ircle/i) { - $ver{ircle}{$nick} = $ver; - - } elsif ($ver =~ /chatzilla/i) { - $ver{chatzilla}{$nick} = $ver; - - } elsif ($ver =~ /pirch/i) { - $ver{pirch}{$nick} = $ver; - - } elsif ($ver =~ /sirc /i) { - $ver{sirc}{$nick} = $ver; - - } elsif ($ver =~ /kvirc/i) { - $ver{kvirc}{$nick} = $ver; - - } elsif ($ver =~ /eggdrop/i) { - $ver{eggdrop}{$nick} = $ver; - - } elsif ($ver =~ /xircon/i) { - $ver{xircon}{$nick} = $ver; - - } else { - &DEBUG("verstats: other: $nick => '$ver'."); - $ver{other}{$nick} = $ver; - } -} - -sub on_version { - $conn = shift(@_); - my ($event) = @_; - my $nick = $event->nick; - - &status(">>> ${b_green}CTCP VERSION$ob request from $b_cyan$nick$ob"); - $conn->ctcp_reply($nick, "VERSION $bot_version"); -} - -sub on_who { - $conn = shift(@_); - my ($event) = @_; - my @args = $event->args; - my $str = $args[5]."!".$args[2]."\@".$args[3]; - - if ($cache{on_who_Hack}) { - $cache{nuhInfo}{lc $args[5]}{Nick} = $args[5]; - $cache{nuhInfo}{lc $args[5]}{User} = $args[2]; - $cache{nuhInfo}{lc $args[5]}{Host} = $args[3]; - $cache{nuhInfo}{lc $args[5]}{NUH} = "$args[5]!$args[2]\@$args[3]"; - return; - } - - if ($args[5] =~ /^nickserv$/i and !$nickserv) { - &DEBUG("ok... we did a who for nickserv."); - &rawout("PRIVMSG NickServ :IDENTIFY $param{'nickServ_pass'}"); - } - - $nuh{lc $args[5]} = $args[5]."!".$args[2]."\@".$args[3]; -} - -sub on_whois { - $conn = shift(@_); - my ($event) = @_; - my @args = $event->args; - - $nuh{lc $args[1]} = $args[1]."!".$args[2]."\@".$args[3]; -} - -sub on_whoischannels { - $conn = shift(@_); - my ($event) = @_; - my @args = $event->args; - - &DEBUG("on_whoischannels: @args"); -} - -sub on_useronchannel { - $conn = shift(@_); - my ($event) = @_; - my @args = $event->args; - - &DEBUG("on_useronchannel: @args"); - &joinNextChan(); -} - -### -### since joinnextchan is hooked onto on_endofnames, these are needed. -### - -sub on_chanfull { - $conn = shift(@_); - my ($event) = @_; - my @args = $event->args; - - &status(">>> chanfull/$b_blue$args[1]$ob"); - - &joinNextChan(); -} - -sub on_inviteonly { - $conn = shift(@_); - my ($event) = @_; - my @args = $event->args; - - &status(">>> inviteonly/$b_cyan$args[1]$ob"); - - &joinNextChan(); -} - -sub on_banned { - $conn = shift(@_); - my ($event) = @_; - my @args = $event->args; - my $chan = $args[1]; - - &status(">>> banned/$b_blue$chan$ob $b_cyan$args[0]$ob, removing autojoin for $chan"); - delete $chanconf{$chan}{autojoin}; - &joinNextChan(); -} - -sub on_badchankey { - $conn = shift(@_); - my ($event) = @_; - my @args = $event->args; - my $chan = $args[1]; - - &DEBUG("on_badchankey: args => @args, removing autojoin for $chan"); - delete $chanconf{$chan}{autojoin}; - &joinNextChan(); -} - -sub on_useronchan { - $conn = shift(@_); - my ($event) = @_; - my @args = $event->args; - - &DEBUG("on_useronchan: args => @args"); - &joinNextChan(); -} - -# TODO not used yet -sub on_stdin { - my $line = ; - chomp($line); - &FIXME("on_stdin: line => \"$line\""); -} - -1; diff --git a/blootbot/src/IRC/Schedulers.pl b/blootbot/src/IRC/Schedulers.pl deleted file mode 100644 index a59c939..0000000 --- a/blootbot/src/IRC/Schedulers.pl +++ /dev/null @@ -1,1116 +0,0 @@ -# -# ProcessExtra.pl: Extensions to Process.pl -# Author: dms -# Version: v0.5 (20010124) -# Created: 20000117 -# - -# use strict; # TODO - -use POSIX qw(strftime); -use vars qw(%sched %schedule); - -# format: function name = ( -# str chanconfdefault, -# int internaldefault, -# bool deferred, -# int next run, (optional) -# ) - -#%schedule = { -# uptimeLoop => ('', 60, 1), -#}; - -sub setupSchedulersII { - foreach (keys %schedule) { - &queueTask($_, @{ $schedule{$_} }); - } -} - -sub queueTask { - my($codename, $chanconfdef, $intervaldef, $defer) = @_; - my $t = &getChanConfDefault($chanconfdef, $intervaldef, $chan); - my $waittime = &getRandomInt($t); - - if (!defined $waittime) { - &WARN("interval == waittime == UNDEF for $codename."); - return; - } - - my $time = $schedule{$codename}[3]; - if (defined $time and $time > time()) { - &WARN("Sched for $codename already exists in " . &Time2String(time() - $time) . "."); - return; - } - - #&VERB("Scheduling \&$codename() for " . &Time2String($waittime),3); - - my $retval = $conn->schedule($waittime, sub { - \&$codename; - }, @args ); -} - -sub setupSchedulers { - &VERB("Starting schedulers...",2); - - # ONCE OFF. - - # REPETITIVE. - # 2 for on next-run. - &randomQuote(2); - &randomFactoid(2); - &seenFlush(2); - &leakCheck(2); # mandatory - &seenFlushOld(2); - &miscCheck2(2); # mandatory - &slashdotLoop(2); - &plugLoop(2); - &kernelLoop(2); - &wingateWriteFile(2); - &factoidCheck(2); # takes a couple of seconds on a 486. defer it -# TODO: convert to new format... or nuke altogether. - &newsFlush(2); - - # 1 for run straight away - &uptimeLoop(1); - &logLoop(1); - &chanlimitCheck(1); - &netsplitCheck(1); # mandatory - &floodLoop(1); # mandatory - &ignoreCheck(1); # mandatory - &miscCheck(1); # mandatory - &shmFlush(1); # mandatory - sleep 1; - &ircCheck(1); # mandatory - - # TODO: squeeze this into a one-liner. -# my $count = map { exists $sched{$_}{TIME} } keys %sched; - my $count = 0; - foreach (keys %sched) { - my $time = $sched{$_}{TIME}; - next unless (defined $time and $time > time()); - - $count++; - } - - &status("Schedulers: $count will be running."); - &scheduleList(); -} - -sub ScheduleThis { - my ($interval, $codename, @args) = @_; - my $waittime = &getRandomInt($interval); - - if (!defined $waittime) { - &WARN("interval == waittime == UNDEF for $codename."); - return; - } - - my $time = $sched{$codename}{TIME}; - if (defined $time and $time > time()) { - &WARN("Sched for $codename already exists in " . &Time2String(time() - $time) . "."); - return; - } - - &DEBUG("Scheduling \&$codename() " . \&$codename . " for " . &Time2String($waittime),3); - - my $retval = $conn->schedule($waittime, \&$codename, @args); - $sched{$codename}{LABEL} = $retval; - $sched{$codename}{TIME} = time()+$waittime; - $sched{$codename}{LOOP} = 1; -} - -#### -#### LET THE FUN BEGIN. -#### - -sub randomQuote { - my $interval = &getChanConfDefault('randomQuoteInterval', 60, $chan); - if (@_) { - &ScheduleThis($interval, 'randomQuote'); - return if ($_[0] eq '2'); # defer. - } - - foreach ( &ChanConfList('randomQuote') ) { - next unless (&validChan($_)); - - my $line = &getRandomLineFromFile($bot_data_dir. "/blootbot.randtext"); - if (!defined $line) { - &ERROR("random Quote: weird error?"); - return; - } - - &status("sending random Quote to $_."); - &action($_, "Ponders: ".$line); - } - ### TODO: if there were no channels, don't reschedule until channel - ### configuration is modified. -} - -sub randomFactoid { - my ($key,$val); - my $error = 0; - - my $interval = &getChanConfDefault('randomFactoidInterval', 60, $chan); - if (@_) { - &ScheduleThis($interval, 'randomFactoid'); - return if ($_[0] eq '2'); # defer. - } - - foreach ( &ChanConfList('randomFactoid') ) { - next unless (&validChan($_)); - - &status("sending random Factoid to $_."); - while (1) { - ($key,$val) = &randKey('factoids',"factoid_key,factoid_value"); - &DEBUG("rF: $key, $val"); -### $val =~ tr/^[A-Z]/[a-z]/; # blah is Good => blah is good. - last if ((defined $val) and ($val !~ /^ $param{'maxLogSize'}) { - my $date = sprintf("%04d%02d%02d", (gmtime)[5,4,3]); - $file{log} = $param{'logfile'} ."-". $date; - &status("cycling log file."); - - if ( -e $file{log}) { - my $i = 1; - my $newlog; - while () { - $newlog = $file{log}."-".$i; - last if (! -e $newlog); - $i++; - } - $file{log} = $newlog; - } - - &closeLog(); - CORE::system("/bin/mv '$param{'logfile'}' '$file{log}'"); - &compress($file{log}); - &openLog(); - &status("cycling log file."); - } - - ### check if all the logs exceed size. - if (!opendir(LOGS, $bot_log_dir)) { - &WARN("logLoop: could not open dir '$bot_log_dir'"); - return; - } - - my $tsize = 0; - my (%age, %size); - while (defined($_ = readdir LOGS)) { - my $logfile = "$bot_log_dir/$_"; - - next unless ( -f $logfile); - - my $size = -s $logfile; - my $age = (stat $logfile)[9]; - $age{$age} = $logfile; - $size{$logfile} = $size; - $tsize += $size; - } - closedir LOGS; - - my $delete = 0; - while ($tsize > $param{'maxLogSize'}) { - &status("LOG: current size > max ($tsize > $param{'maxLogSize'})"); - my $oldest = (sort {$a <=> $b} keys %age)[0]; - &status("LOG: unlinking $age{$oldest}."); - unlink $age{$oldest}; - $tsize -= $oldest; - $delete++; - } - - ### TODO: add how many b,kb,mb removed? - &status("LOG: removed $delete logs.") if ($delete); -} - -sub seenFlushOld { - if (@_) { - &ScheduleThis(1440, 'seenFlushOld'); - return if ($_[0] eq '2'); # defer. - } - - # is this global-only? - return unless (&IsChanConf('seen') > 0); - return unless (&IsChanConf('seenFlushInterval') > 0); - - # global setting. does not make sense for per-channel. - my $max_time = &getChanConfDefault('seenMaxDays', 30, $chan) *60*60*24; - my $delete = 0; - - if ($param{'DBType'} =~ /^(pgsql|mysql|sqlite(2)?)$/i) { - my $query; - - if ($param{'DBType'} =~ /^(mysql|sqlite(2)?)$/i) { - $query = "SELECT nick,time FROM seen GROUP BY nick HAVING ". - "UNIX_TIMESTAMP() - time > $max_time"; - } else { # pgsql. - $query = "SELECT nick,time FROM seen WHERE ". - "extract(epoch from timestamp 'now') - time > $max_time"; - } - - my $sth = $dbh->prepare($query); - if ($sth->execute) { - while (my @row = $sth->fetchrow_array) { - my ($nick,$time) = @row; - - &sqlDelete('seen', { nick => $nick } ); - $delete++; - } - $sth->finish; - } - } else { - &FIXME("seenFlushOld: for bad DBType:" . $param{'DBType'} . "."); - } - &VERB("SEEN deleted $delete seen entries.",2); - -} - -sub newsFlush { - if (@_) { - &ScheduleThis(60, 'newsFlush'); - return if ($_[0] eq '2'); # defer. - } - - if (!&ChanConfList('News')) { - &DEBUG("newsFlush: news disabled? (chan => $chan)"); - return; - } - - my $delete = 0; - my $oldest = time(); - my %none; - foreach $chan (keys %::news) { - my $i = 0; - my $total = scalar(keys %{ $::news{$chan} }); - - if (!$total) { - delete $::news{$chan}; - next; - } - - foreach $item (keys %{ $::news{$chan} }) { - my $t = $::news{$chan}{$item}{Expire}; - - my $tadd = $::news{$chan}{$item}{Time}; - $oldest = $tadd if ($oldest > $tadd); - - next if ($t == 0 or $t == -1); - if ($t < 1000) { - &status("newsFlush: Fixed Expire time for $chan/$item, should not happen anyway."); - $::news{$chan}{$item}{Expire} = time() + $t*60*60*24; - next; - } - - my $delta = $t - time(); - - next unless (time() > $t); - - # TODO: show how old it was. - delete $::news{$chan}{$item}; - &status("NEWS: (newsflush) deleted '$item'"); - $delete++; - $i++; - } - - &status("NEWS (newsflush) {$chan}: deleted [$i/$total] news entries.") if ($i); - $none{$chan} = 1 if ($total == $i); - } - - # TODO: flush users aswell. - my $duser = 0; - foreach $chan (keys %::newsuser) { - next if (exists $none{$chan}); - - foreach (keys %{ $::newsuser{$chan} }) { - my $t = $::newsuser{$chan}{$_}; - if (!defined $t or ($t > 2 and $t < 1000)) { - &DEBUG("something wrong with newsuser{$chan}{$_} => $t"); - next; - } - - next unless ($oldest > $t); - - delete $::newsuser{$chan}{$_}; - $duser++; - } - - my $i = scalar(keys %{ $::newsuser{$chan} }); - delete $::newsuser{$chan} unless ($i); - } - - if ($delete or $duser) { - &status("NewsFlush: deleted: $delete news entries; $duser user cache."); - } -} - -sub chanlimitCheck { - my $interval = &getChanConfDefault('chanlimitcheckInterval', 10, $chan); - my $mynick=$conn->nick(); - - if (@_) { - &ScheduleThis($interval, 'chanlimitCheck'); - return if ($_[0] eq '2'); - } - - my $str = join(' ', &ChanConfList('chanlimitcheck') ); - - foreach $chan ( &ChanConfList('chanlimitcheck') ) { - next unless (&validChan($chan)); - - if ($chan eq '_default') { - &WARN("chanlimit: we're doing $chan!! HELP ME!"); - next; - } - - my $limitplus = &getChanConfDefault('chanlimitcheckPlus', 5, $chan); - my $newlimit = scalar(keys %{ $channels{$chan}{''} }) + $limitplus; - my $limit = $channels{$chan}{'l'}; - - if (scalar keys %netsplitservers) { - if (defined $limit) { - &status("chanlimit: netsplit; removing it for $chan."); - $conn->mode($chan, "-l"); - $cache{chanlimitChange}{$chan} = time(); - &status("chanlimit: netsplit; removed."); - } - - next; - } - - if (defined $limit and scalar keys %{ $channels{$chan}{''} } > $limit) { - &FIXME("LIMIT: set too low!!!"); - ### run NAMES again and flush it. - } - - if (defined $limit and $limit == $newlimit) { - $cache{chanlimitChange}{$chan} = time(); - next; - } - - if (!exists $channels{$chan}{'o'}{$mynick}) { - &status("chanlimit: dont have ops on $chan.") unless (exists $cache{warn}{chanlimit}{$chan}); - $cache{warn}{chanlimit}{$chan} = 1; - &chanServCheck($chan); - next; - } - delete $cache{warn}{chanlimit}{$chan}; - - if (!defined $limit) { - &status("chanlimit: $chan: setting for first time or from netsplit."); - } - - if (exists $cache{chanlimitChange}{$chan}) { - my $delta = time() - $cache{chanlimitChange}{$chan}; - if ($delta < $interval*60) { - &DEBUG("chanlimit: not going to change chanlimit! ($delta<$interval*60)"); - return; - } - } - - $conn->mode($chan, "+l", $newlimit); - $cache{chanlimitChange}{$chan} = time(); - } -} - -sub netsplitCheck { - my ($s1,$s2); - - if (@_) { - &ScheduleThis(15, 'netsplitCheck'); - return if ($_[0] eq '2'); - } - - $cache{'netsplitCache'}++; -# &DEBUG("running netsplitCheck... $cache{netsplitCache}"); - - if (!scalar %netsplit and scalar %netsplitservers) { - &DEBUG("nsC: !hash netsplit but hash netsplitservers <- removing!"); - undef %netsplitservers; - return; - } - - # well... this shouldn't happen since %netsplit code does it anyway. - foreach $s1 (keys %netsplitservers) { - - foreach $s2 (keys %{ $netsplitservers{$s1} }) { - my $delta = time() - $netsplitservers{$s1}{$s2}; - - if ($delta > 60*30) { - &status("netsplit between $s1 and $s2 appears to be stale."); - delete $netsplitservers{$s1}{$s2}; - &chanlimitCheck(); - } - } - - my $i = scalar(keys %{ $netsplitservers{$s1} }); - delete $netsplitservers{$s1} unless ($i); - } - - # %netsplit hash checker. - my $count = scalar keys %netsplit; - my $delete = 0; - foreach (keys %netsplit) { - if (&IsNickInAnyChan($_)) { # why would this happen? -# &DEBUG("nsC: $_ is in some chan; removing from netsplit list."); - delete $netsplit{$_}; - $delete++; - next; - } - - next unless (time() - $netsplit{$_} > 60*15); - - $delete++; - delete $netsplit{$_}; - } - - # yet another hack. - foreach (keys %channels) { - my $i = $cache{maxpeeps}{$chan} || 0; - my $j = scalar(keys %{ $channels{$chan} }); - next unless ($i > 10 and 0.25*$i > $j); - - &DEBUG("netsplit: 0.25*max($i) > current($j); possible netsplit?"); - } - - if ($delete) { - my $j = scalar(keys %netsplit); - &status("nsC: removed from netsplit list: (before: $count; after: $j)"); - } - - if (!scalar %netsplit and scalar %netsplitservers) { - &DEBUG("nsC: ok hash netsplit is NULL; purging hash netsplitservers"); - undef %netsplitservers; - } - - if ($count and !scalar keys %netsplit) { - &DEBUG("nsC: netsplit is hopefully gone. reinstating chanlimit check."); - &chanlimitCheck(); - } -} - -sub floodLoop { - my $delete = 0; - my $who; - - if (@_) { - &ScheduleThis(60, 'floodLoop'); # minutes. - return if ($_[0] eq '2'); - } - - my $time = time(); - my $interval = &getChanConfDefault('floodCycle',60, $chan); - - foreach $who (keys %flood) { - foreach (keys %{ $flood{$who} }) { - if (!exists $flood{$who}{$_}) { - &WARN("flood{$who}{$_} undefined?"); - next; - } - - if ($time - $flood{$who}{$_} > $interval) { - delete $flood{$who}{$_}; - $delete++; - } - } - } - &VERB("floodLoop: deleted $delete items.",2); -} - -sub seenFlush { - if (@_) { - my $interval = &getChanConfDefault('seenFlushInterval', 60, $chan); - &ScheduleThis($interval, 'seenFlush'); - return if ($_[0] eq '2'); - } - - my %stats; - my $nick; - my $flushed = 0; - $stats{'count_old'} = &countKeys('seen') || 0; - $stats{'new'} = 0; - $stats{'old'} = 0; - - if ($param{'DBType'} =~ /^(mysql|pgsql|sqlite(2)?)$/i) { - foreach $nick (keys %seencache) { - my $retval = &sqlSet('seen', {'nick' => lc $seencache{$nick}{'nick'}}, { - time => $seencache{$nick}{'time'}, - host => $seencache{$nick}{'host'}, - channel => $seencache{$nick}{'chan'}, - message => $seencache{$nick}{'msg'}, - } ); - - delete $seencache{$nick}; - $flushed++; - } - } else { - &DEBUG("seenFlush: NO VALID FACTOID SUPPORT?"); - } - - &status("Seen: Flushed $flushed entries.") if ($flushed); - &VERB(sprintf(" new seen: %03.01f%% (%d/%d)", - $stats{'new'}*100/($stats{'count_old'} || 1), - $stats{'new'}, ( $stats{'count_old'} || 1) ), 2) if ($stats{'new'}); - &VERB(sprintf(" now seen: %3.1f%% (%d/%d)", - $stats{'old'}*100 / ( &countKeys('seen') || 1), - $stats{'old'}, &countKeys('seen') ), 2) if ($stats{'old'}); - - &WARN("scalar keys seenflush != 0!") if (scalar keys %seenflush); -} - -sub leakCheck { - my ($blah1,$blah2); - my $count = 0; - - if (@_) { - &ScheduleThis(240, 'leakCheck'); - return if ($_[0] eq '2'); - } - - # flood. this is dealt with in floodLoop() - foreach $blah1 (keys %flood) { - foreach $blah2 (keys %{ $flood{$blah1} }) { - $count += scalar(keys %{ $flood{$blah1}{$blah2} }); - } - } - &VERB("leak: hash flood has $count total keys.",2); - - # floodjoin. - $count = 0; - foreach $blah1 (keys %floodjoin) { - foreach $blah2 (keys %{ $floodjoin{$blah1} }) { - $count += scalar(keys %{ $floodjoin{$blah1}{$blah2} }); - } - } - &VERB("leak: hash floodjoin has $count total keys.",2); - - # floodwarn. - $count = scalar(keys %floodwarn); - &VERB("leak: hash floodwarn has $count total keys.",2); - - my $chan; - foreach $chan (grep /[A-Z]/, keys %channels) { - &DEBUG("leak: chan => '$chan'."); - my ($i,$j); - foreach $i (keys %{ $channels{$chan} }) { - foreach (keys %{ $channels{$chan}{$i} }) { - &DEBUG("leak: \$channels{$chan}{$i}{$_} ..."); - } - } - } - - # chanstats - $count = scalar(keys %chanstats); - &VERB("leak: hash chanstats has $count total keys.",2); - - # nuh. - my $delete = 0; - foreach (keys %nuh) { - next if (&IsNickInAnyChan($_)); - next if (exists $dcc{CHAT}{$_}); - - delete $nuh{$_}; - $delete++; - } - - &status("leak: $delete nuh{} items deleted; now have ". - scalar(keys %nuh) ) if ($delete); -} - -sub ignoreCheck { - if (@_) { - &ScheduleThis(60, 'ignoreCheck'); - return if ($_[0] eq '2'); # defer. - } - - my $time = time(); - my $count = 0; - - foreach (keys %ignore) { - my $chan = $_; - - foreach (keys %{ $ignore{$chan} }) { - my @array = @{ $ignore{$chan}{$_} }; - - next unless ($array[0] and $time > $array[0]); - - delete $ignore{$chan}{$_}; - &status("ignore: $_/$chan has expired."); - $count++; - } - } - - $cache{ignoreCheckTime} = time(); - - &VERB("ignore: $count items deleted.",2); -} - -sub ircCheck { - if (@_) { - &ScheduleThis(15, 'ircCheck'); - return if ($_[0] eq '2'); # defer. - } - - $cache{statusSafe} = 1; - foreach (sort keys %conns) { - $conn=$conns{$_}; - my $mynick=$conn->nick(); - &DEBUG("ircCheck for $_"); - my @join = &getJoinChans(1); - if (scalar @join) { - &FIXME('ircCheck: found channels to join! ' . join(',',@join)); - &joinNextChan(); - } - - # TODO: fix on_disconnect() - - if (time() - $msgtime > 3600) { - # TODO: shouldn't we use cache{connect} somewhere? - if (exists $cache{connect}) { - &WARN("ircCheck: no msg for 3600 and disco'd! reconnecting!"); - $msgtime = time(); # just in case. - &ircloop(); - delete $cache{connect}; - } else { - &status('ircCheck: possible lost in space; checking.'. - scalar(gmtime) ); - &msg($mynick, 'TEST'); - $cache{connect} = time(); - } - } - - if (grep /^\s*$/, keys %channels) { - &WARN('ircCheck: we have a NULL chan in hash channels? removing!'); - if (!exists $channels{''}) { - &DEBUG('ircCheck: this should never happen!'); - } - - delete $channels{''}; - } - } - - $cache{statusSafe} = 0; - - ### USER FILE. - if ($utime_userfile > $wtime_userfile and time() - $wtime_userfile > 3600) { - &writeUserFile(); - $wtime_userfile = time(); - } - ### CHAN FILE. - if ($utime_chanfile > $wtime_chanfile and time() - $wtime_chanfile > 3600) { - &writeChanFile(); - $wtime_chanfile = time(); - } -} - -sub miscCheck { - if (@_) { - &ScheduleThis(120, 'miscCheck'); - return if ($_[0] eq '2'); # defer. - } - - # SHM check. - my @ipcs; - if ( -x "/usr/bin/ipcs") { - @ipcs = `/usr/bin/ipcs`; - } else { - &WARN("ircCheck: no 'ipcs' binary."); - return; - } - - # make backup of important files. - &mkBackup( $bot_state_dir."/blootbot.chan", 60*60*24*3); - &mkBackup( $bot_state_dir."/blootbot.users", 60*60*24*3); - &mkBackup( $bot_base_dir."/blootbot-news.txt", 60*60*24*1); - - # flush cache{lobotomy} - foreach (keys %{ $cache{lobotomy} }) { - next unless (time() - $cache{lobotomy}{$_} > 60*60); - delete $cache{lobotomy}{$_}; - } - - ### check modules if they've been modified. might be evil. - &reloadAllModules(); - - # shmid stale remove. - foreach (@ipcs) { - chop; - - # key, shmid, owner, perms, bytes, nattch - next unless (/^(0x\d+) (\d+)\s+(\S+)\s+(\d+)\s+(\d+)\s+/); - - my ($shmid, $size) = ($2,$5); - next unless ($shmid != $shm and $size == 2000); - my $z = &shmRead($shmid); - if ($z =~ /^(\S+):(\d+):(\d+): /) { - my $n = $1; - my $pid = $2; - my $time = $3; - next if (time() - $time < 60*60); - # FIXME remove not-pid shm if parent process dead - next if ($pid == $bot_pid); - # don't touch other bots, if they're running. - next unless ($param{ircUser} =~ /^\Q$n\E$/); - } else { - &DEBUG("shm: $shmid is not ours or old blootbot => ($z)"); - next; - } - - &status("SHM: nuking shmid $shmid"); - CORE::system("/usr/bin/ipcrm shm $shmid >/dev/null"); - } -} - -sub miscCheck2 { - if (@_) { - &ScheduleThis(240, 'miscCheck2'); - return if ($_[0] eq '2'); # defer. - } - - # debian check. - opendir(DEBIAN, "$bot_state_dir/debian"); - foreach ( grep /gz$/, readdir(DEBIAN) ) { - my $exit = CORE::system("gzip -t $bot_state_dir/debian/$_"); - next unless ($exit); - - &status("debian: unlinking file => $_"); - unlink "$bot_state_dir/debian/$_"; - } - closedir DEBIAN; - - # compress logs that should have been compressed. - # TODO: use strftime? - my ($day,$month,$year) = (gmtime(time()))[3,4,5]; - my $date = sprintf("%04d%02d%02d",$year+1900,$month+1,$day); - - if (!opendir(DIR,"$bot_log_dir")) { - &ERROR("misccheck2: log dir $bot_log_dir does not exist."); - closedir DIR; - return -1; - } - - while (my $f = readdir(DIR)) { - next unless ( -f "$bot_log_dir/$f"); - next if ($f =~ /gz|bz2/); - next unless ($f =~ /(\d{8})/); - next if ($date eq $1); - - &compress("$bot_log_dir/$f"); - } - closedir DIR; -} - -### this is semi-scheduled -sub getNickInUse { -# FIXME: broken for multiple connects -# if ($ident eq $param{'ircNick'}) { -# &status("okay, got my nick back."); -# return; -# } -# -# if (@_) { -# &ScheduleThis(30, 'getNickInUse'); -# return if ($_[0] eq '2'); # defer. -# } -# -# &nick( $param{'ircNick'} ); -} - -sub uptimeLoop { - return if (!defined &uptimeWriteFile); -# return unless &IsParam('Uptime'); - - if (@_) { - &ScheduleThis(60, 'uptimeLoop'); - return if ($_[0] eq '2'); # defer. - } - - &uptimeWriteFile(); -} - -sub slashdotLoop { - - if (@_) { - &ScheduleThis(60, 'slashdotLoop'); - return if ($_[0] eq '2'); - } - - my @chans = &ChanConfList('slashdotAnnounce'); - return unless (scalar @chans); - - &Forker('slashdot', sub { - my $line = &Slashdot::slashdotAnnounce(); - return unless (defined $line); - - foreach (@chans) { - next unless (&::validChan($_)); - - &::status("sending slashdot update to $_."); - ¬ice($_, "Slashdot: $line"); - } - } ); -} - -sub plugLoop { - - if (@_) { - &ScheduleThis(60, 'plugLoop'); - return if ($_[0] eq '2'); - } - - my @chans = &ChanConfList('plugAnnounce'); - return unless (scalar @chans); - - &Forker('Plug', sub { - my $line = &Plug::plugAnnounce(); - return unless (defined $line); - - foreach (@chans) { - next unless (&::validChan($_)); - - &::status("sending plug update to $_."); - ¬ice($_, "Plug: $line"); - } - } ); -} - -sub kernelLoop { - if (@_) { - &ScheduleThis(240, 'kernelLoop'); - return if ($_[0] eq '2'); - } - - my @chans = &ChanConfList('kernelAnnounce'); - return unless (scalar @chans); - - &Forker('Kernel', sub { - my @data = &Kernel::kernelAnnounce(); - - foreach (@chans) { - next unless (&::validChan($_)); - - &::status("sending kernel update to $_."); - my $c = $_; - foreach (@data) { - ¬ice($c, "Kernel: $_"); - } - } - } ); -} - -sub wingateCheck { - return unless &IsChanConf('Wingate') > 0; - - ### FILE CACHE OF OFFENDING WINGATES. - foreach (grep /^$host$/, @wingateBad) { - &status("Wingate: RUNNING ON $host BY $who"); - &ban("*!*\@$host", '') if &IsChanConf('wingateBan') > 0; - - my $reason = &getChanConf('wingateKick'); - - next unless ($reason); - &kick($who, '', $reason) - } - - ### RUN CACHE OF TRIED WINGATES. - if (grep /^$host$/, @wingateCache) { - push(@wingateNow, $host); # per run. - push(@wingateCache, $host); # cache per run. - } else { - &DEBUG("Already scanned $host. good."); - } - - my $interval = &getChanConfDefault('wingateInterval', 60, $chan); # seconds. - return if (defined $forked{'Wingate'}); - return if (time() - $wingaterun <= $interval); - return unless (scalar(keys %wingateToDo)); - - $wingaterun = time(); - - &Forker('Wingate', sub { &Wingate::Wingates(keys %wingateToDo); } ); - undef @wingateNow; -} - -### TODO: ?? -sub wingateWriteFile { - if (@_) { - &ScheduleThis(60, 'wingateWriteFile'); - return if ($_[0] eq '2'); # defer. - } - - return unless (scalar @wingateCache); - - my $file = "$bot_base_dir/$param{'ircUser'}.wingate"; - if ($bot_pid != $$) { - &DEBUG('wingateWriteFile: Reorganising!'); - - open(IN, $file); - while () { - chop; - push(@wingateNow, $_); - } - close IN; - - # very lame hack. - my %hash = map { $_ => 1 } @wingateNow; - @wingateNow = sort keys %hash; - } - - &DEBUG('wingateWF: writing...'); - open(OUT, ">$file"); - foreach (@wingateNow) { - print OUT "$_\n"; - } - close OUT; -} - -sub factoidCheck { - if (@_) { - &ScheduleThis(720, 'factoidCheck'); - return if ($_[0] eq '2'); # defer. - } - - my @list = &searchTable('factoids', 'factoid_key', 'factoid_key', " #DEL#"); - my $stale = &getChanConfDefault('factoidDeleteDelay', 14, $chan) *60*60*24; - if ($stale < 1) { - # disable it since it's 'illegal'. - return; - } - - my $time = time(); - - foreach (@list) { - my $age = &getFactInfo($_, 'modified_time'); - - if (!defined $age or $age !~ /^\d+$/) { - if (scalar @list > 50) { - if (!$cache{warnDel}) { - &WARN("list is over 50 (".scalar(@list)."... giving it a miss."); - $cache{warnDel} = 1; - last; - } - } - - &WARN("del factoid: old cruft (no time): $_"); - &delFactoid($_); - next; - } - - next unless ($time - $age > $stale); - - my $fix = $_; - $fix =~ s/ #DEL#$//g; - my $agestr = &Time2String($time - $age); - &status("safedel: Removing '$_' for good. [$agestr old]"); - - &delFactoid($_); - } -} - -sub dccStatus { - return unless (scalar keys %{ $dcc{CHAT} }); - - if (@_) { - &ScheduleThis(10, 'dccStatus'); - return if ($_[0] eq '2'); # defer. - } - - my $time = strftime("%H:%M", gmtime(time()) ); - - my $c; - foreach (keys %channels) { - my $c = $_; - my $users = keys %{ $channels{$c}{''} }; - my $chops = keys %{ $channels{$c}{o} }; - my $bans = keys %{ $channels{$c}{b} }; - - my $txt = "[$time] $c: $users members ($chops chops), $bans bans"; - foreach (keys %{ $dcc{'CHAT'} }) { - next unless (exists $channels{$c}{''}{lc $_}); - $conn->privmsg($dcc{'CHAT'}{$_}, $txt); - } - } -} - -sub scheduleList { - ### - # custom: - # a - time == now. - # b - weird time. - ### - - my $reply = "sched:"; - foreach (keys %{ $irc->{_queue}}) { - my $q = $_; - my $coderef = $irc->{_queue}->{$q}->[1]; - my $sched; - foreach (keys %sched) { - my $schedname = $_; - next unless defined(\&$schedname); - next unless ($coderef eq \&$schedname); - $sched = $schedname; - last; - } - - my $time = $irc->{_queue}->{$q}->[0] - time(); - - if (defined $sched) { - $reply = "$reply, $sched($q):" . &Time2String($time); - } else { - $reply = "$reply, NULL($q):" . &Time2String($time); - } - } - - &DEBUG("$reply"); -} - -sub mkBackup { - my($file, $time) = @_; - my $backup = 0; - - if (! -f $file) { - &VERB("mkB: file '$file' does not exist.",2); - return; - } - - my $age = 'New'; - if ( -e "$file~" ) { - $backup++ if ((stat $file)[9] - (stat "$file~")[9] > $time); - my $delta = time() - (stat "$file~")[9]; - $age = &Time2String($delta); - } else { - $backup++; - } - - return unless ($backup); - - ### TODO: do internal copying. - &status("Backup: $file ($age)"); - CORE::system("/bin/cp $file $file~"); -} - -1; diff --git a/blootbot/src/Misc.pl b/blootbot/src/Misc.pl deleted file mode 100644 index 47cbd36..0000000 --- a/blootbot/src/Misc.pl +++ /dev/null @@ -1,680 +0,0 @@ -# -# Misc.pl: Miscellaneous stuff. -# Author: dms -# Version: 20000124 -# NOTE: Based on code by Kevin Lenzo & Patrick Cole (c) 1997 -# - -use strict; - -use vars qw(%file %mask %param %cmdstats %myModules); -use vars qw($msgType $who $bot_pid $nuh $shm $force_public_reply - $no_timehires $bot_data_dir $addrchar); - -sub help { - my $topic = shift; - my $file = $bot_data_dir."/blootbot.help"; - my %help = (); - - # crude hack for performStrictReply() to work as expected. - $msgType = 'private' if ($msgType eq 'public'); - - if (!open(FILE, $file)) { - &ERROR("Failed reading help file ($file): $!"); - return; - } - - while (defined(my $help = )) { - $help =~ s/^[\# ].*//; - chomp $help; - next unless $help; - my ($key, $val) = split(/:/, $help, 2); - - $val =~ s/^\s+//; - $val =~ s/^D:/\002 Desc\002:/; - $val =~ s/^E:/\002Example\002:/; - $val =~ s/^N:/\002 NOTE\002:/; - $val =~ s/^U:/\002 Usage\002:/; - $val =~ s/##/$key/; - $val =~ s/__/\037/g; - $val =~ s/==/ /; - - $help{$key} = '' if (!exists $help{$key}); - $help{$key} .= $val."\n"; - } - close FILE; - - if (!defined $topic or $topic eq '') { - &msg($who, $help{'main'}); - - my $i = 0; - my @array; - my $count = scalar(keys %help); - my $reply; - foreach (sort keys %help) { - push(@array,$_); - $reply = scalar(@array) ." topics: ". - join("\002,\002 ", @array); - $i++; - - if (length $reply > 400 or $count == $i) { - &msg($who,$reply); - undef @array; - } - } - - return ''; - } - - $topic = &fixString(lc $topic); - - if (exists $help{$topic}) { - foreach (split /\n/, $help{$topic}) { - &performStrictReply($_); - } - } else { - &performStrictReply("no help on $topic. Use 'help' without arguments."); - } - - return ''; -} - -sub getPath { - my ($pathnfile) = @_; - - ### TODO: gotta hate an if statement. - if ($pathnfile =~ /(.*)\/(.*?)$/) { - return $1; - } else { - return "."; - } -} - -sub timeget { - if ($no_timehires) { # fallback. - return time(); - } else { # the real thing. - return [gettimeofday()]; - } -} - -sub timedelta { - my($start_time) = shift; - - if ($no_timehires) { # fallback. - return time() - $start_time; - } else { # the real thing. - return tv_interval ($start_time); - } -} - -### -### FORM Functions. -### - -### -# Usage; &formListReply($rand, $prefix, @list); -sub formListReply { - my($rand, $prefix, @list) = @_; - my $total = scalar @list; - my $maxshow = &getChanConfDefault('maxListReplyCount', 15, $chan); - my $maxlen = &getChanConfDefault('maxListReplyLength', 400, $chan); - my $reply; - - # remove irc overhead - $maxlen -= 30; - - # no results. - return $prefix ."returned no results." unless ($total); - - # random. - if ($rand) { - my @rand; - foreach (&makeRandom($total)) { - push(@rand, $list[$_]); - last if (scalar @rand == $maxshow); - } - if ($total > $maxshow) { - @list = sort @rand; - } else { - @list = @rand; - } - } elsif ($total > $maxshow) { - &status("formListReply: truncating list."); - - @list = @list[0..$maxshow-1]; - } - - # form the reply. - # FIXME: should grow and exit when full, not discard any that are oversize - while () { - $reply = $prefix ."(\002". scalar(@list). "\002"; - $reply .= " of \002$total\002" if ($total != scalar @list); - $reply .= "): " . join(" \002;;\002 ", @list) ."."; - - last if (length($reply) < $maxlen and scalar(@list) <= $maxshow); - last if (scalar(@list) == 1); - - pop @list; - } - - return $reply; -} - -### Intelligence joining of arrays. -# Usage: &IJoin(@array); -sub IJoin { - if (!scalar @_) { - return 'NULL'; - } elsif (scalar @_ == 1) { - return $_[0]; - } else { - return join(', ',@{_}[0..$#_-1]) . " and $_[$#_]"; - } -} - -##### -# Usage: &Time2String(seconds); -sub Time2String { - my ($time) = @_; - my $prefix = ''; - my (@s, @t); - - return 'NULL' if (!defined $time); - return $time if ($time !~ /\d+/); - - if ($time < 0) { - $time = - $time; - $prefix = "- "; - } - - $t[0] = int($time) % 60; - $t[1] = int($time / 60) % 60; - $t[2] = int($time / 3600) % 24; - $t[3] = int($time / 86400); - - push(@s, "$t[3]d") if ($t[3] != 0); - push(@s, "$t[2]h") if ($t[2] != 0); - push(@s, "$t[1]m") if ($t[1] != 0); - push(@s, "$t[0]s") if ($t[0] != 0 or !@s); - - my $retval = $prefix.join(' ', @s); - $retval =~ s/(\d+)/\002$1\002/g; - return $retval; -} - -### -### FIX Functions. -### - -# Usage: &fixFileList(@files); -sub fixFileList { - my @files = @_; - my %files; - - # generate a hash list. - foreach (@files) { - next unless /^(.*\/)(.*?)$/; - - $files{$1}{$2} = 1; - } - @files = (); # reuse the array. - - # sort the hash list appropriately. - foreach (sort keys %files) { - my $file = $_; - my @keys = sort keys %{ $files{$file} }; - my $i = scalar(@keys); - - if (scalar @keys > 3) { - pop @keys while (scalar @keys > 3); - push(@keys, "..."); - } - - if ($i > 1) { - $file .= "\002{\002". join("\002|\002", @keys) ."\002}\002"; - } else { - $file .= $keys[0]; - } - - push(@files,$file); - } - - return @files; -} - -# Usage: &fixString($str); -sub fixString { - my ($str, $level) = @_; - if (!defined $str) { - &WARN("fixString: str == NULL."); - return ''; - } - - for ($str) { - s/^\s+//; # remove start whitespaces. - s/\s+$//; # remove end whitespaces. - s/\s+/ /g; # remove excessive whitespaces. - - next unless (defined $level); - if (s/[\cA-\c_]//ig) { # remove control characters. - &DEBUG("stripped control chars"); - } - } - - return $str; -} - -# Usage: &fixPlural($str,$int); -sub fixPlural { - my ($str,$int) = @_; - - if (!defined $str) { - &WARN("fixPlural: str == NULL."); - return; - } - - if (!defined $int or $int =~ /^\D+$/) { - &WARN("fixPlural: int != defined or int"); - return $str; - } - - if ($str eq 'has') { - $str = 'have' if ($int > 1); - } elsif ($str eq 'is') { - $str = 'are' if ($int > 1); - } elsif ($str eq 'was') { - $str = 'were' if ($int > 1); - } elsif ($str eq 'this') { - $str = 'these' if ($int > 1); - } elsif ($str =~ /y$/) { - if ($int > 1) { - if ($str =~ /ey$/) { - $str .= 's'; # eg: 'money' => 'moneys'. - } else { - $str =~ s/y$/ies/; - } - } - } else { - $str .= 's' if ($int != 1); - } - - return $str; -} - -########## -### get commands. -### - -sub getRandomLineFromFile { - my($file) = @_; - - if (!open(IN, $file)) { - &WARN("gRLfF: could not open ($file): $!"); - return; - } - - my @lines = ; - close IN; - - if (!scalar @lines) { - &ERROR("GRLF: nothing loaded?"); - return; - } - - # could we use the filehandler instead and put it through getRandom? - while (my $line = &getRandom(@lines)) { - chop $line; - - next if ($line =~ /^\#/); - next if ($line =~ /^\s*$/); - - return $line; - } -} - -sub getLineFromFile { - my($file,$lineno) = @_; - - if (! -f $file) { - &ERROR("getLineFromFile: file '$file' does not exist."); - return 0; - } - - if (open(IN,$file)) { - my @lines = ; - close IN; - - if ($lineno > scalar @lines) { - &ERROR("getLineFromFile: lineno exceeds line count from file."); - return 0; - } - - my $line = $lines[$lineno-1]; - chop $line; - return $line; - } else { - &ERROR("gLFF: Could not open file ($file): $!"); - return 0; - } -} - -# Usage: &getRandom(@array); -sub getRandom { - my @array = @_; - - srand(); - return $array[int(rand(scalar @array))]; -} - -# Usage: &getRandomInt("30-60"); -sub getRandomInt { - my $str = $_[0]; - - if (!defined $str) { - &WARN("gRI: str == NULL."); - return; - } - - srand(); - - if ($str =~ /^(\d+(\.\d+)?)$/) { - my $i = $1; - my $fuzzy = int(rand 5); - if ($i < 10) { - return $i; - } - if (rand > 0.5) { - return ($i - $fuzzy)*60; - } else { - return ($i + $fuzzy)*60; - } - } elsif ($str =~ /^(\d+)-(\d+)$/) { - return ($2 - $1)*int(rand $1)*60; - } else { - return $str; # hope we're safe. - } - - &ERROR("getRandomInt: invalid arg '$str'."); - return 1800; -} - -########## -### Is commands. -### - -sub iseq { - my ($left,$right) = @_; - return 0 unless defined $right; - return 0 unless defined $left; - return 1 if ($left =~ /^\Q$right$/i); -} - -sub isne { - my $retval = &iseq(@_); - return 1 unless ($retval); - return 0; -} - -# Usage: &IsHostMatch($nuh); -sub IsHostMatch { - my ($thisnuh) = @_; - my (%this,%local); - - if ($nuh =~ /^(\S+)!(\S+)@(\S+)/) { - $local{'nick'} = lc $1; - $local{'user'} = lc $2; - $local{'host'} = &makeHostMask(lc $3); - } - - if (!defined $thisnuh) { - &WARN("IHM: thisnuh == NULL."); - return 0; - } elsif ($thisnuh =~ /^(\S+)!(\S+)@(\S+)/) { - $this{'nick'} = lc $1; - $this{'user'} = lc $2; - $this{'host'} = &makeHostMask(lc $3); - } else { - &WARN("IHM: thisnuh is invalid '$thisnuh'."); - return 1 if ($thisnuh eq ''); - return 0; - } - - # auth if 1) user and host match 2) user and nick match. - # this may change in the future. - - if ($this{'user'} =~ /^\Q$local{'user'}\E$/i) { - return 2 if ($this{'host'} eq $local{'host'}); - return 1 if ($this{'nick'} eq $local{'nick'}); - } - return 0; -} - -#### -# Usage: &isStale($file, $age); -sub isStale { - my ($file, $age) = @_; - - if (!defined $age) { - &WARN("isStale: age == NULL."); - return 1; - } - - if (!defined $file) { - &WARN("isStale: file == NULL."); - return 1; - } - - &DEBUG("!exist $file") if (! -f $file); - - return 1 unless ( -f $file); - if ($file =~ /idx/) { - my $age2 = time() - (stat($file))[9]; - &VERB("stale: $age2. (". &Time2String($age2) .")",2); - } - $age *= 60*60*24 if ($age >= 0 and $age < 30); - - return 1 if (time() - (stat($file))[9] > $age); - return 0; -} - -sub isFileUpdated { - my ($file, $time) = @_; - - if (! -f $file) { - return 1; - } - - my $time_file = (stat $file)[9]; - - if ($time <= $time_file) { - return 0; - } else { - return 1; - } -} - -########## -### make commands. -### - -# Usage: &makeHostMask($host); -sub makeHostMask { - my ($host) = @_; - my $nu = ''; - - if ($host =~ s/^(\S+!\S+\@)//) { - &DEBUG("mHM: detected nick!user\@ for host arg; fixing"); - &DEBUG("nu => $nu"); - $nu = $1; - } - - if ($host =~ /^$mask{ip}$/) { - return $nu."$1.$2.$3.*"; - } - - my @array = split(/\./, $host); - return $nu.$host if (scalar @array <= 3); - return $nu."*.".join('.',@{array}[1..$#array]); -} - -# Usage: &makeRandom(int); -sub makeRandom { - my ($max) = @_; - my @retval; - my %done; - - if ($max =~ /^\D+$/) { - &ERROR("makeRandom: arg ($max) is not integer."); - return 0; - } - - if ($max < 1) { - &ERROR("makeRandom: arg ($max) is not positive."); - return 0; - } - - srand(); - while (scalar keys %done < $max) { - my $rand = int(rand $max); - next if (exists $done{$rand}); - - push(@retval,$rand); - $done{$rand} = 1; - } - - return @retval; -} - -sub checkMsgType { - my ($reply) = @_; - return unless (&IsParam('minLengthBeforePrivate')); - return if ($force_public_reply); - - if (length $reply > $param{'minLengthBeforePrivate'}) { - &status("Reply: len reply > minLBP ($param{'minLengthBeforePrivate'}); msgType now private."); - $msgType = 'private'; - } -} - -### -### Valid. -### - -# Usage: &validExec($string); -sub validExec { - my ($str) = @_; - - if ($str =~ /[\`\'\"\|]/) { # invalid. - return 0; - } else { # valid. - return 1; - } -} - -# Usage: &hasProfanity($string); -sub hasProfanity { - my ($string) = @_; - my $profanity = 1; - - for (lc $string) { - /fuck/ and last; - /dick|dildo/ and last; - /shit/ and last; - /pussy|[ck]unt/ and last; - /wh[0o]re|bitch|slut/ and last; - - $profanity = 0; - } - - return $profanity; -} - -sub IsChanConfOrWarn { - my ($param) = @_; - - if (&IsChanConf($param) > 0) { - return 1; - } else { - ### TODO: specific reason why it failed. - &msg($who, "unfortunately, \002$param\002 is disabled in my configuration") unless ($addrchar); - return 0; - } -} - -sub Forker { - my ($label, $code) = @_; - my $pid; - - &shmFlush(); - &VERB("double fork detected; not forking.",2) if ($$ != $bot_pid); - - if (&IsParam('forking') and $$ == $bot_pid) { - return unless &addForked($label); - - $SIG{CHLD} = 'IGNORE'; - $pid = eval { fork() }; - return if $pid; # parent does nothing - - select(undef, undef, undef, 0.2); -# &status("fork starting for '$label', PID == $$."); - &status("--- fork starting for '$label', PID == $$, bot_pid == $bot_pid ---"); - &shmWrite($shm,"SET FORKPID $label $$"); - - sleep 1; - } - - ### TODO: use AUTOLOAD - ### very lame hack. - if ($label !~ /-/ and !&loadMyModule($label)) { - &DEBUG("Forker: failed?"); - &delForked($label); - } - - if (defined $code) { - $code->(); # weird, hey? - } else { - &WARN("Forker: code not defined!"); - } - - &delForked($label); -} - -sub closePID { - return 1 unless (exists $file{PID}); - return 1 unless ( -f $file{PID}); - return 1 if (unlink $file{PID}); - return 0 if ( -f $file{PID}); -} - -sub mkcrypt { - my($str) = @_; - my $salt = join '',('.','/',0..9,'A'..'Z','a'..'z')[rand 64, rand 64]; - - return crypt($str, $salt); -} - -sub closeStats { - return unless (&getChanConfList('ircTextCounters')); - - foreach (keys %cmdstats) { - my $type = $_; - my $i = &sqlSelect('stats', 'counter', { - nick => $type, - type => 'cmdstats', - } ); - my $z = 0; - $z++ unless ($i); - - $i += $cmdstats{$type}; - - - &sqlSet('stats', {'nick' => $type}, { - type => 'cmdstats', - 'time' => time(), - counter => $i, - } ); - } -} - -1; diff --git a/blootbot/src/Modules/BZFlag.pl b/blootbot/src/Modules/BZFlag.pl deleted file mode 100755 index 69672c2..0000000 --- a/blootbot/src/Modules/BZFlag.pl +++ /dev/null @@ -1,360 +0,0 @@ -#!/usr/bin/perl -# -# BZFlag -# Copyright (c) 1993 - 2002 Tim Riker -# -# This package is free software; you can redistribute it and/or -# modify it under the terms of the license found in the file -# named LICENSE that should have accompanied this file. -# -# THIS PACKAGE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR -# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED -# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. - -package BZFlag; -use strict; -use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK); - -my $no_BZFlag; - -BEGIN { - $no_BZFlag = 0; - eval "use Socket"; - eval "use LWP::UserAgent"; - $no_BZFlag++ if ($@); -} - -sub BZFlag { - my ($message) = @_; - my ($retval); - if ($no_BZFlag) { - &::status("BZFlag module requires Socket."); - return 'BZFlag module not active'; - } - if ($message =~ /^bzfquery\s+([^:]*)(?::([0-9]*))?$/xi) { - $retval = &query($1,$2); - } elsif ($message =~ /^bzflist$/xi) { - $retval = &list(); - } else { - $retval = "BZFlag: unhandled command \"$message\""; - } - &::performStrictReply($retval); -} - -sub list { - my ($response); - my $ua = new LWP::UserAgent; - $ua->proxy('http', $::param{'httpProxy'}) if (&::IsParam('httpProxy')); - - $ua->timeout(5); - - my $req = HTTP::Request->new('GET', 'http://db.bzflag.org/db/?action=LIST'); - my $res = $ua->request($req); - my %servers; - my $totalServers = 0; - for my $line (split("\n",$res->content)) { - my ($serverport, $version, $flags, $ip, $comments) = split(" ",$line,5); - # not "(A4)18" to handle old dumb perl - my ($style, $maxShots, $shakeWins, $shakeTimeout, $maxPlayerScore, $maxTeamScore, $maxTime, - $maxPlayers, $rogueSize, $rogueMax, $redSize, $redMax, $greenSize, $greenMax, - $blueSize, $blueMax, $purpleSize, $purpleMax, $observerSize, $observerMax) = - unpack('A4A4A4A4A4A4A4A2A2A2A2A2A2A2A2A2A2A2A2A2', $flags); - my $playerSize = hex($rogueSize) + hex($redSize) + hex($greenSize) - + hex($blueSize) + hex($purpleSize) + hex($observerSize); - $servers{$serverport} = $playerSize; - $servers{$version} += $playerSize; - $servers{'PLAYERS'} += $playerSize; - $totalServers += 1; - } - $response .= "s=$totalServers"; - foreach my $key (sort {$servers{$b} <=> $servers{$a}} (keys(%servers))) { - if ($servers{$key} > 0) { - $response .= " $key($servers{$key})"; - } - } - &::performStrictReply($response); - return; -} - -sub list17 { - my ($response); - my $ua = new LWP::UserAgent; - $ua->proxy('http', $::param{'httpProxy'}) if (&::IsParam('httpProxy')); - - $ua->timeout(5); - - my $req = HTTP::Request->new('GET', 'http://list.bzflag.org:5156/'); - my $res = $ua->request($req); - my %servers; - my $totalServers = 0; - my $totalPlayers = 0; - for my $line (split("\n",$res->content)) { - my ($serverport, $version, $flags, $ip, $comments) = split(" ",$line,5); - # not "(A4)18" to handle old dumb perl - my ($style,$maxPlayers,$maxShots, - $rogueSize,$redSize,$greenSize,$blueSize,$purpleSize, - $rogueMax,$redMax,$greenMax,$blueMax,$purpleMax, - $shakeWins,$shakeTimeout, - $maxPlayerScore,$maxTeamScore,$maxTime) = - unpack('A4A4A4A4A4A4A4A4A4A4A4A4A4A4A4A4A4A4', $flags); - my $playerSize = hex($rogueSize) + hex($redSize) + hex($greenSize) - + hex($blueSize) + hex($purpleSize); - $servers{$serverport} = $playerSize; - $totalServers += 1; - $totalPlayers += $playerSize; - } - $response .= "s=$totalServers p=$totalPlayers"; - foreach my $key (sort {$servers{$b} <=> $servers{$a}} (keys(%servers))) { - if ($servers{$key} > 0) { - $response .= " $key($servers{$key})"; - } - } - &::performStrictReply($response); - return; -} - -sub querytext { - my ($servernameport) = @_; - my ($servername,$port) = split(":",$servernameport); - if ($no_BZFlag) { - &::status("BZFlag module requires Socket."); - return 'BZFlag module not active'; - } - #my @teamName = ('Rogue', 'Red', 'Green', 'Blue', 'Purple', 'Observer', 'Rabbit'); - my @teamName = ('X', 'R', 'G', 'B', 'P', 'O', 'K'); - my ($message, $server, $response); - $port = 5154 unless $port; - - # socket define - my $sockaddr = 'S n a4 x8'; - - # port to port number - my ($name,$aliases,$proto) = getprotobyname('tcp'); - ($name,$aliases,$port) = getservbyname($port,'tcp') unless $port =~ /^\d+$/; - - # get server address - my ($type,$len,$serveraddr); - ($name,$aliases,$type,$len,$serveraddr) = gethostbyname($servername); - $server = pack($sockaddr, AF_INET, $port, $serveraddr); - - # connect - # TODO wrap this with a 5 second alarm() - return 'socket() error' unless socket(S1, AF_INET, SOCK_STREAM, $proto); - return "could not connect to $servername:$port" unless connect(S1, $server); - - # don't buffer - select(S1); $| = 1; select(STDOUT); - - # get hello - my $buffer; - return 'read error' unless read(S1, $buffer, 8) == 8; - - # parse reply - my ($magic,$major,$minor,$something,$revision) = unpack("a4 a1 a1 a1 a1", $buffer); - my ($version) = $magic . $major . $minor . $something . $revision; - - # quit if version isn't valid - return 'not a bzflag server' if ($magic ne 'BZFS'); - $response .= "$major$minor$something$revision "; - # check version - if ($version eq 'BZFS0026') { - # 1.11.x handled here - return 'read error' unless read(S1, $buffer, 1) == 1; - my ($id) = unpack('C', $buffer); - return "rejected by server" if ($id == 255); - - # send game request - print S1 pack('n2', 0, 0x7167); - - # get reply - my $nbytes = read(S1, $buffer, 4); - my ($infolen, $infocode) = unpack('n2', $buffer); - if ($infocode == 0x6774) { - # read and ignore MsgGameTime from new servers - $nbytes = read(S1, $buffer, 8); - $nbytes = read(S1, $buffer, 4); - ($infolen, $infocode) = unpack('n2', $buffer); - } - $nbytes = read(S1, $buffer, 42); - if ($nbytes != 42) { - return "Error: read $nbytes bytes, expecting 46: $^E\n"; - } - - my ($style,$maxPlayers,$maxShots, - $rogueSize,$redSize,$greenSize,$blueSize,$purpleSize,$observerSize, - $rogueMax,$redMax,$greenMax,$blueMax,$purpleMax,$observerMax, - $shakeWins,$shakeTimeout, - $maxPlayerScore,$maxTeamScore,$maxTime,$timeElapsed) = unpack('n23', $buffer); - return "bad server data $infocode" unless $infocode == 0x7167; - - # send players request - print S1 pack('n2', 0, 0x7170); - - # get number of teams and players we'll be receiving - return 'count read error' unless read(S1, $buffer, 8) == 8; - my ($countlen,$countcode,$numTeams,$numPlayers) = unpack('n4', $buffer); - - # get the teams - return 'bad count data' unless $countcode == 0x7170; - return 'count read error' unless read(S1, $buffer, 5) == 5; - ($countlen,$countcode,$numTeams) = unpack("n n C", $buffer); - for (1..$numTeams) { - return 'team read error' unless read(S1, $buffer, 8) == 8; - my ($team,$size,$won,$lost) = unpack('n4', $buffer); - if ($size > 0) { - my $score = $won - $lost; - $response .= "$teamName[$team]:$score($won-$lost) "; - } - } - - # get the players - for (1..$numPlayers) { - last unless read(S1, $buffer, 175) == 175; - my ($playerlen,$playercode,$pID,$type,$team,$won,$lost,$tks,$sign,$email) = - unpack('n2Cn5A32A128', $buffer); - #my ($playerlen,$playercode,$pAddr,$pPort,$pNum,$type,$team,$won,$lost,$sign,$email) = - # unpack("n2Nn2 n4A32A128", $buffer); - return 'bad player data' unless $playercode == 0x6170; - my $score = $won - $lost; - $response .= " $sign($teamName[$team]"; - $response .= ":$email" if ($email); - $response .= ")$score($won-$lost)"; - } - $response .= "No Players" if ($numPlayers < 1); - - # close socket - } elsif ($major == 1 && $minor == 9) { - # 1.10.x handled here - $revision = $something * 10 + $revision; - return 'read error' unless read(S1, $buffer, 1) == 1; - my ($id) = unpack('C', $buffer); - - # send game request - print S1 pack('n2', 0, 0x7167); - - # FIXME the packets are wrong from here down - # get reply - return 'server read error' unless read(S1, $buffer, 40) == 40; - my ($infolen,$infocode,$style,$maxPlayers,$maxShots, - $rogueSize,$redSize,$greenSize,$blueSize,$purpleSize, - $rogueMax,$redMax,$greenMax,$blueMax,$purpleMax, - $shakeWins,$shakeTimeout, - $maxPlayerScore,$maxTeamScore,$maxTime) = unpack('n20', $buffer); - return 'bad server data' unless $infocode == 0x7167; - - # send players request - print S1 pack('n2', 0, 0x7170); - - # get number of teams and players we'll be receiving - return 'count read error' unless read(S1, $buffer, 8) == 8; - my ($countlen,$countcode,$numTeams,$numPlayers) = unpack('n4', $buffer); - - # get the teams - return 'bad count data' unless $countcode == 0x7170; - return 'count read error' unless read(S1, $buffer, 5) == 5; - ($countlen,$countcode,$numTeams) = unpack("n n C", $buffer); - for (1..$numTeams) { - return 'team read error' unless read(S1, $buffer, 8) == 8; - my ($team,$size,$won,$lost) = unpack('n4', $buffer); - if ($size > 0) { - my $score = $won - $lost; - $response .= "$teamName[$team]:$score($won-$lost) "; - } - } - - # get the players - for (1..$numPlayers) { - last unless read(S1, $buffer, 175) == 175; - my ($playerlen,$playercode,$pID,$type,$team,$won,$lost,$tks,$sign,$email) = - unpack('n2Cn5A32A128', $buffer); - #my ($playerlen,$playercode,$pAddr,$pPort,$pNum,$type,$team,$won,$lost,$sign,$email) = - # unpack("n2Nn2 n4A32A128", $buffer); - return 'bad player data' unless $playercode == 0x6170; - my $score = $won - $lost; - $response .= " $sign($teamName[$team]"; - $response .= ":$email" if ($email); - $response .= ")$score($won-$lost)"; - } - $response .= "No Players" if ($numPlayers < 1); - - # close socket - close(S1); - } elsif ($major == 1 && $minor == 0 && $something == 7) { - # 1.7* versions handled here - # old servers send a reconnect port number - return 'read error' unless read(S1, $buffer, 2) == 2; - my ($reconnect) = unpack('n', $buffer); - $minor = $minor * 10 + $something; - # quit if rejected - return 'rejected by server' if ($reconnect == 0); - - # reconnect on new port - $server = pack($sockaddr, AF_INET, $reconnect, $serveraddr); - return 'socket() error on reconnect' unless socket(S, AF_INET, SOCK_STREAM, $proto); - return "could not reconnect to $servername:$reconnect" unless connect(S, $server); - select(S); $| = 1; select(STDOUT); - - # close first socket - close(S1); - - # send game request - print S pack('n2', 0, 0x7167); - - # get reply - return 'server read error' unless read(S, $buffer, 40) == 40; - my ($infolen,$infocode,$style,$maxPlayers,$maxShots, - $rogueSize,$redSize,$greenSize,$blueSize,$purpleSize, - $rogueMax,$redMax,$greenMax,$blueMax,$purpleMax, - $shakeWins,$shakeTimeout, - $maxPlayerScore,$maxTeamScore,$maxTime) = unpack('n20', $buffer); - return 'bad server data' unless $infocode == 0x7167; - - # send players request - print S pack('n2', 0, 0x7170); - - # get number of teams and players we'll be receiving - return 'count read error' unless read(S, $buffer, 8) == 8; - my ($countlen,$countcode,$numTeams,$numPlayers) = unpack('n4', $buffer); - return 'bad count data' unless $countcode == 0x7170; - - # get the teams - for (1..$numTeams) { - return 'team read error' unless read(S, $buffer, 14) == 14; - my ($teamlen,$teamcode,$team,$size,$aSize,$won,$lost) = unpack('n7', $buffer); - return 'bad team data' unless $teamcode == 0x7475; - if ($size > 0) { - my $score = $won - $lost; - $response .= "$teamName[$team]:$score($won-$lost) "; - } - } - - # get the players - for (1..$numPlayers) { - last unless read(S, $buffer, 180) == 180; - my ($playerlen,$playercode,$pAddr,$pPort,$pNum,$type,$team,$won,$lost,$sign,$email) = - unpack("n2Nn2 n4A32A128", $buffer); - return 'bad player data' unless $playercode == 0x6170; - my $score = $won - $lost; - $response .= " $sign($teamName[$team]"; - $response .= ":$email" if ($email); - $response .= ")$score($won-$lost)"; - } - $response .= "No Players" if ($numPlayers <= 1); - - # close socket - close(S); - } else { - $response = "incompatible version: $version"; - } - - return $response; -} - -sub query { - my ($servernameport) = @_; - &::performStrictReply(&querytext($servernameport)); - return; -} - -1; -# vim: ts=2 sw=2 diff --git a/blootbot/src/Modules/Debian.pl b/blootbot/src/Modules/Debian.pl deleted file mode 100644 index 963b58a..0000000 --- a/blootbot/src/Modules/Debian.pl +++ /dev/null @@ -1,1148 +0,0 @@ -# -# Debian.pl: Frontend to debian contents and packages files -# Author: dms -# Version: v0.8 (20000918) -# Created: 20000106 -# - -package Debian; - -use strict; -no strict 'refs'; # FIXME: dstats aborts if set - -my $announce = 0; -my $defaultdist = 'sid'; -my $refresh = &::getChanConfDefault('debianRefreshInterval', 7, $::chan) * 60 * 60 * 24; -my $debug = 0; -my $debian_dir = $::bot_state_dir . '/debian'; -my $country = 'nl'; # well .config it yourself then. ;-) -my $protocol = 'http'; -# EDIT THIS (i386, amd64, powerpc, [etc.]): -my $arch = "$arch"; - -# format: "alias=real". -my %dists = ( - 'unstable' => 'sid', - 'testing' => 'lenny', - 'stable' => 'etch', - 'oldstable' => 'sarge', - 'incoming' => 'incoming', -); - -my %urlcontents = ( - "Contents-##DIST-$arch.gz" => - "$protocol://ftp.$country.debian.org". - "/debian/dists/##DIST/Contents-$arch.gz", - "Contents-##DIST-$arch-non-US.gz" => - "$protocol://non-us.debian.org". - "/debian-non-US/dists/##DIST/non-US/Contents-$arch.gz", -); - -my %urlpackages = ( - "Packages-##DIST-main-$arch.gz" => - "$protocol://ftp.$country.debian.org". - "/debian/dists/##DIST/main/binary-$arch/Packages.gz", - "Packages-##DIST-contrib-$arch.gz" => - "$protocol://ftp.$country.debian.org". - "/debian/dists/##DIST/contrib/binary-$arch/Packages.gz", - "Packages-##DIST-non-free-$arch.gz" => - "$protocol://ftp.$country.debian.org". - "/debian/dists/##DIST/non-free/binary-$arch/Packages.gz", -); - -##################### -### COMMON FUNCTION.... -####################### - -#### -# Usage: &DebianDownload($dist, %hash); -sub DebianDownload { - my ($dist, %urls) = @_; - my $bad = 0; - my $good = 0; - - if (! -d $debian_dir) { - &::status("Debian: creating debian dir."); - mkdir($debian_dir, 0755); - } - - # fe dists. - # Download the files. - my $file; - foreach $file (keys %urls) { - my $url = $urls{$file}; - $url =~ s/##DIST/$dist/g; - $file =~ s/##DIST/$dist/g; - my $update = 0; - - if ( -f $file ) { - my $last_refresh = (stat $file)[9]; - $update++ if (time() - $last_refresh > $refresh); - } else { - $update++; - } - - next unless ($update); - - &::DEBUG("announce == $announce.") if ($debug); - if ($good + $bad == 0 and !$announce) { - &::status("Debian: Downloading files for '$dist'."); - &::msg($::who, "Updating debian files... please wait."); - $announce++; - } - - if (exists $::debian{$url}) { - &::DEBUG("2: ".(time - $::debian{$url})." <= $refresh") if ($debug); - next if (time() - $::debian{$url} <= $refresh); - &::DEBUG("stale for url $url; updating!") if ($debug); - } - - if ($url =~ /^ftp:\/\/(.*?)\/(\S+)\/(\S+)$/) { - my ($host,$path,$thisfile) = ($1,$2,$3); - - if (!&::ftpGet($host,$path,$thisfile,$file)) { - &::WARN("deb: down: $file == BAD."); - $bad++; - next; - } - - } elsif ($url =~ /^http:\/\/\S+\/\S+$/) { - - if (!&::getURLAsFile($url,$file)) { - &::WARN("deb: down: http: $file == BAD."); - $bad++; - next; - } - - } else { - &::ERROR("Debian: invalid format of url => ($url)."); - $bad++; - next; - } - - if (! -f $file) { - &::WARN("deb: down: http: !file"); - $bad++; - next; - } - -# my $exit = system("/bin/gzip -t $file"); -# if ($exit) { -# &::WARN("deb: $file is corrupted ($exit) :/"); -# unlink $file; -# next; -# } - - &::DEBUG("deb: download: good.") if ($debug); - $good++; - } - - # ok... lets just run this. - &::miscCheck() if (&::whatInterface() =~ /IRC/); - - if ($good) { - &generateIndex($dist); - return 1; - } else { - return -1 unless ($bad); # no download. - &::DEBUG("DD: !good and bad($bad). :("); - return 0; - } -} - -########################### -# DEBIAN CONTENTS SEARCH FUNCTIONS. -######## - -#### -# Usage: &searchContents($query); -sub searchContents { - my ($dist, $query) = &getDistroFromStr($_[0]); - &::status("Debian: Contents search for '$query' in '$dist'."); - my $dccsend = 0; - - $dccsend++ if ($query =~ s/^dcc\s+//i); - - $query =~ s/\\([\^\$])/$1/g; # hrm? - $query =~ s/^\s+|\s+$//g; - - if (!&::validExec($query)) { - &::msg($::who, 'search string looks fuzzy.'); - return; - } - - if ($dist eq 'incoming') { # nothing yet. - &::DEBUG('sC: dist = "incoming". no contents yet.'); - return; - } else { - my %urls = &fixDist($dist, %urlcontents); - # download contents file. - &::DEBUG('deb: download 1.') if ($debug); - if (!&DebianDownload($dist, %urls)) { - &::WARN('Debian: could not download files.'); - } - } - - # start of search. - my $start_time = &::timeget(); - - my $found = 0; - my $front = 0; - my %contents; - my $grepRE; - ### TODO: search properly if /usr/bin/blah is done. - if ($query =~ s/\$$//) { - &::DEBUG("deb: search-regex found.") if ($debug); - $grepRE = "$query\[ \t]"; - } elsif ($query =~ s/^\^//) { - &::DEBUG("deb: front marker regex found.") if ($debug); - $front = 1; - $grepRE = $query; - } else { - $grepRE = "$query*\[ \t]"; - } - - # fix up grepRE for "*". - $grepRE =~ s/\*/.*/g; - - my @files; - foreach (keys %urlcontents) { - s/##DIST/$dist/g; - - next unless ( -f "$debian_dir/$_" ); - push(@files, "$debian_dir/$_"); - } - - if (!scalar @files) { - &::ERROR("sC: no files?"); - &::msg($::who, "failed."); - return; - } - - my $files = join(' ', @files); - - my $regex = $query; - $regex =~ s/\./\\./g; - $regex =~ s/\*/\\S*/g; - $regex =~ s/\?/./g; - - open(IN,"zegrep -h '$grepRE' $files |"); - # wonderful abuse of if, last, next, return, and, unless ;) - while () { - last if ($found > 100); - - next unless (/^\.?\/?(.*?)[\t\s]+(\S+)\n$/); - my ($file,$package) = ("/".$1,$2); - - if ($query =~ /[\/\*\\]/) { - next unless (eval { $file =~ /$regex/ }); - return unless &checkEval($@); - } else { - my ($basename) = $file =~ /^.*\/(.*)$/; - next unless (eval { $basename =~ /$regex/ }); - return unless &checkEval($@); - } - next if ($query !~ /\.\d\.gz/ and $file =~ /\/man\//); - next if ($front and eval { $file !~ /^\/$query/ }); - return unless &checkEval($@); - - $contents{$package}{$file} = 1; - $found++; - } - close IN; - - my $pkg; - - ### send results with dcc. - if ($dccsend) { - if (exists $::dcc{'SEND'}{$::who}) { - &::msg($::who, "DCC already active!"); - return; - } - - if (!scalar %contents) { - &::msg($::who,"search returned no results."); - return; - } - - my $file = "$::param{tempDir}/$::who.txt"; - if (!open OUT, ">$file") { - &::ERROR("Debian: cannot write file for dcc send."); - return; - } - - foreach $pkg (keys %contents) { - foreach (keys %{ $contents{$pkg} }) { - # TODO: correct padding. - print OUT "$_\t\t\t$pkg\n"; - } - } - close OUT; - - &::shmWrite($::shm, "DCC SEND $::who $file"); - - return; - } - - &::status("Debian: $found contents results found."); - - my @list; - foreach $pkg (keys %contents) { - my @tmplist = &::fixFileList(keys %{ $contents{$pkg} }); - my @sublist = sort { length $a <=> length $b } @tmplist; - - pop @sublist while (scalar @sublist > 3); - - $pkg =~ s/\,/\037\,\037/g; # underline ','. - push(@list, "(". join(', ',@sublist) .") in $pkg"); - } - # sort the total list from shortest to longest... - @list = sort { length $a <=> length $b } @list; - - # show how long it took. - my $delta_time = &::timedelta($start_time); - &::status(sprintf("Debian: %.02f sec to complete query.", $delta_time)) if ($delta_time > 0); - - my $prefix = "Debian Search of '$query' "; - if (scalar @list) { # @list. - &::performStrictReply( &::formListReply(0, $prefix, @list) ); - return; - } - - # !@list. - &::DEBUG("deb: ok, !\@list, searching desc for '$query'.") if ($debug); - @list = &searchDesc($query); - - if (!scalar @list) { - my $prefix = "Debian Package/File/Desc Search of '$query' "; - &::performStrictReply( &::formListReply(0, $prefix, ) ); - - } elsif (scalar @list == 1) { # list = 1. - &::DEBUG("deb: list == 1; showing package info of '$list[0]'."); - &infoPackages("info", $list[0]); - - } else { # list > 1. - my $prefix = "Debian Desc Search of '$query' "; - &::performStrictReply( &::formListReply(0, $prefix, @list) ); - } -} - -#### -# Usage: &searchAuthor($query); -sub searchAuthor { - my ($dist, $query) = &getDistroFromStr($_[0]); - &::DEBUG("deb: searchAuthor: dist => '$dist', query => '$query'.") if ($debug); - $query =~ s/^\s+|\s+$//g; - - # start of search. - my $start_time = &::timeget(); - &::status("Debian: starting author search."); - - my $files; - my ($bad,$good) = (0,0); - my %urls = %urlpackages; - - foreach (keys %urlpackages) { - s/##DIST/$dist/g; - - if (! -f "$debian_dir/$_" ) { - $bad++; - next; - } - - $good++; - $files .= " ".$_; - } - - &::DEBUG("deb: good = $good, bad = $bad...") if ($debug); - - if ($good == 0 and $bad != 0) { - my %urls = &fixDist($dist, %urlpackages); - &::DEBUG("deb: download 2."); - - if (!&DebianDownload($dist, %urls)) { - &::ERROR("Debian(sA): could not download files."); - return; - } - } - - my (%maint, %pkg, $package); - open(IN,"zegrep -h '^Package|^Maintainer' $files |"); - while () { - if (/^Package: (\S+)$/) { - $package = $1; - - } elsif (/^Maintainer: (.*) \<(\S+)\>$/) { - my($name,$email) = ($1,$2); - if ($package eq "") { - &::DEBUG("deb: sA: package == NULL."); - next; - } - $maint{$name}{$email} = 1; - $pkg{$name}{$package} = 1; - $package = ""; - - } else { - chop; - &::WARN("debian: invalid line: '$_' (1)."); - } - } - close IN; - - my %hash; - # TODO: can we use 'map' here? - foreach (grep /\Q$query\E/i, keys %maint) { - $hash{$_} = 1; - } - - # TODO: should we only search email if '@' is used? - if (scalar keys %hash < 15) { - my $name; - - foreach $name (keys %maint) { - my $email; - - foreach $email (keys %{ $maint{$name} }) { - next unless ($email =~ /\Q$query\E/i); - next if (exists $hash{$name}); - $hash{$name} = 1; - } - } - } - - my @list = keys %hash; - if (scalar @list != 1) { - my $prefix = "Debian Author Search of '$query' "; - &::performStrictReply( &::formListReply(0, $prefix, @list) ); - return 1; - } - - &::DEBUG("deb: showing all packages by '$list[0]'...") if ($debug); - - my @pkg = sort keys %{ $pkg{$list[0]} }; - - # show how long it took. - my $delta_time = &::timedelta($start_time); - &::status(sprintf("Debian: %.02f sec to complete query.", $delta_time)) if ($delta_time > 0); - - my $email = join(', ', keys %{ $maint{$list[0]} }); - my $prefix = "Debian Packages by $list[0] \002<\002$email\002>\002 "; - &::performStrictReply( &::formListReply(0, $prefix, @pkg) ); -} - -#### -# Usage: &searchDesc($query); -sub searchDesc { - my ($dist, $query) = &getDistroFromStr($_[0]); - &::DEBUG("deb: searchDesc: dist => '$dist', query => '$query'.") if ($debug); - $query =~ s/^\s+|\s+$//g; - - # start of search. - my $start_time = &::timeget(); - &::status("Debian: starting desc search."); - - my $files; - my ($bad,$good) = (0,0); - my %urls = %urlpackages; - - foreach (keys %urlpackages) { - s/##DIST/$dist/g; - - if (! -f "$debian_dir/$_" ) { - $bad++; - next; - } - - $good++; - $files .= " $debian_dir/$_"; - } - - &::DEBUG("deb(2): good = $good, bad = $bad...") if ($debug); - - if ($good == 0 and $bad != 0) { - my %urls = &fixDist($dist, %urlpackages); - &::DEBUG("deb: download 2c.") if ($debug); - - if (!&DebianDownload($dist, %urls)) { - &::ERROR("deb: sD: could not download files."); - return; - } - } - - my $regex = $query; - $regex =~ s/\./\\./g; - $regex =~ s/\*/\\S*/g; - $regex =~ s/\?/./g; - - my (%desc, $package); - open(IN,"zegrep -h '^Package|^Description' $files |"); - while () { - if (/^Package: (\S+)$/) { - $package = $1; - } elsif (/^Description: (.*)$/) { - my $desc = $1; - next unless (eval { $desc =~ /$regex/i }); - return unless &checkEval($@); - - if ($package eq "") { - &::WARN("sD: package == NULL?"); - next; - } - - $desc{$package} = $desc; - $package = ""; - - } else { - chop; - &::WARN("debian: invalid line: '$_'. (2)"); - } - } - close IN; - - # show how long it took. - my $delta_time = &::timedelta($start_time); - &::status(sprintf("Debian: %.02f sec to complete query.", $delta_time)) if ($delta_time > 0); - - return keys %desc; -} - -#### -# Usage: &generateIncoming(); -sub generateIncoming { - my $pkgfile = $debian_dir."/Packages-incoming"; - my $idxfile = $pkgfile.".idx"; - my $stale = 0; - $stale++ if (&::isStale($pkgfile.".gz", $refresh)); - $stale++ if (&::isStale($idxfile, $refresh)); - &::DEBUG("deb: gI: stale => '$stale'.") if ($debug); - return 0 unless ($stale); - - ### STATIC URL. - my %ftp = &::ftpList("llug.sep.bnl.gov", "/pub/debian/Incoming/"); - - if (!open PKG, ">$pkgfile") { - &::ERROR("cannot write to pkg $pkgfile."); - return 0; - } - if (!open IDX, ">$idxfile") { - &::ERROR("cannot write to idx $idxfile."); - return 0; - } - - print IDX "*$pkgfile.gz\n"; - my $file; - foreach $file (sort keys %ftp) { - next unless ($file =~ /deb$/); - - if ($file =~ /^(\S+)\_(\S+)\_(\S+)\.deb$/) { - print IDX "$1\n"; - print PKG "Package: $1\n"; - print PKG "Version: $2\n"; - print PKG "Architecture: ", (defined $4) ? $4 : "all", "\n"; - } - print PKG "Filename: $file\n"; - print PKG "Size: $ftp{$file}\n"; - print PKG "\n"; - } - close IDX; - close PKG; - - system("gzip -9fv $pkgfile"); # lame fix. - - &::status("Debian: generateIncoming() complete."); -} - - -############################## -# DEBIAN PACKAGE INFO FUNCTIONS. -######### - -# Usage: &getPackageInfo($query,$file); -sub getPackageInfo { - my ($package, $file) = @_; - - if (! -f $file) { - &::status("gPI: file $file does not exist?"); - return 'NULL'; - } - - my $found = 0; - my (%pkg, $pkg); - - open(IN, "/bin/zcat $file 2>&1 |"); - - my $done = 0; - while (!eof IN) { - $_ = ; - - next if (/^ \S+/); # package long description. - - # package line. - if (/^Package: (.*)\n$/) { - $pkg = $1; - if ($pkg =~ /^\Q$package\E$/i) { - $found++; # we can use pkg{'package'} instead. - $pkg{'package'} = $pkg; - } - - next; - } - - if ($found) { - chop; - - if (/^Version: (.*)$/) { - $pkg{'version'} = $1; - } elsif (/^Priority: (.*)$/) { - $pkg{'priority'} = $1; - } elsif (/^Section: (.*)$/) { - $pkg{'section'} = $1; - } elsif (/^Size: (.*)$/) { - $pkg{'size'} = $1; - } elsif (/^Installed-Size: (.*)$/i) { - $pkg{'installed'} = $1; - } elsif (/^Description: (.*)$/) { - $pkg{'desc'} = $1; - } elsif (/^Filename: (.*)$/) { - $pkg{'find'} = $1; - } elsif (/^Pre-Depends: (.*)$/) { - $pkg{'depends'} = "pre-depends on $1"; - } elsif (/^Depends: (.*)$/) { - if (exists $pkg{'depends'}) { - $pkg{'depends'} .= "; depends on $1"; - } else { - $pkg{'depends'} = "depends on $1"; - } - } elsif (/^Maintainer: (.*)$/) { - $pkg{'maint'} = $1; - } elsif (/^Provides: (.*)$/) { - $pkg{'provides'} = $1; - } elsif (/^Suggests: (.*)$/) { - $pkg{'suggests'} = $1; - } elsif (/^Conflicts: (.*)$/) { - $pkg{'conflicts'} = $1; - } - -### &::DEBUG("=> '$_'."); - } - - # blank line. - if (/^$/) { - undef $pkg; - last if ($found); - next; - } - - next if (defined $pkg); - } - - close IN; - - %pkg; -} - -# Usage: &infoPackages($query,$package); -sub infoPackages { - my ($query,$dist,$package) = ($_[0], &getDistroFromStr($_[1])); - - &::status("Debian: Searching for package '$package' in '$dist'."); - - # download packages file. - # hrm... - my %urls = &fixDist($dist, %urlpackages); - if ($dist ne "incoming") { - &::DEBUG("deb: download 3.") if ($debug); - - if (!&DebianDownload($dist, %urls)) { # no good download. - &::WARN("Debian(iP): could not download ANY files."); - } - } - - # check if the package is valid. - my $incoming = 0; - my @files = &validPackage($package, $dist); - if (!scalar @files) { - &::status("Debian: no valid package found; checking incoming."); - @files = &validPackage($package, "incoming"); - - if (scalar @files) { - &::status("Debian: cool, it exists in incoming."); - $incoming++; - } else { - &::msg($::who, "Package '$package' does not exist."); - return 0; - } - } - - if (scalar @files > 1) { - &::WARN("same package in more than one file; random."); - &::DEBUG("THIS SHOULD BE FIXED SOMEHOW!!!"); - $files[0] = &::getRandom(@files); - } - - if (! -f $files[0]) { - &::WARN("files[0] ($files[0]) doesn't exist."); - &::msg($::who, "FIXME: $files[0] does not exist?"); - return 'NULL'; - } - - ### TODO: if specific package is requested, note down that a version - ### exists in incoming. - - my $found = 0; - my $file = $files[0]; - my ($pkg); - - ### TODO: use fe, dump to a hash. if only one version of the package - ### exists. do as normal otherwise list all versions. - if (! -f $file) { - &::ERROR("D:iP: file '$file' DOES NOT EXIST!!! should never happen."); - return 0; - } - my %pkg = &getPackageInfo($package, $file); - - $query = "info" if ($query eq "dinfo"); - - # 'fm'-like output. - if ($query eq "info") { - if (scalar keys %pkg <= 5) { - &::DEBUG("deb: running debianCheck() due to problems (".scalar(keys %pkg).")."); - &debianCheck(); - &::DEBUG("deb: end of debianCheck()"); - - &::msg($::who,"Debian: Package appears to exist but I could not retrieve info about it..."); - return; - } - - $pkg{'info'} = "\002(\002". $pkg{'desc'} ."\002)\002"; - $pkg{'info'} .= ", section ".$pkg{'section'}; - $pkg{'info'} .= ", is ".$pkg{'priority'}; -# $pkg{'info'} .= ". Version: \002$pkg{'version'}\002"; - $pkg{'info'} .= ". Version: \002$pkg{'version'}\002 ($dist)"; - $pkg{'info'} .= ", Packaged size: \002". int($pkg{'size'}/1024) ."\002 kB"; - $pkg{'info'} .= ", Installed size: \002$pkg{'installed'}\002 kB"; - - if ($incoming) { - &::status("iP: info requested and pkg is in incoming, too."); - my %incpkg = &getPackageInfo($query, $debian_dir ."/Packages-incoming"); - - if (scalar keys %incpkg) { - $pkg{'info'} .= ". Is in incoming ($incpkg{'file'})."; - } else { - &::ERROR("iP: pkg $query is in incoming but we couldn't get any info?"); - } - } - } - - if ($dist eq "incoming") { - $pkg{'info'} .= "Version: \002$pkg{'version'}\002"; - $pkg{'info'} .= ", Packaged size: \002". int($pkg{'size'}/1024) ."\002 kB"; - $pkg{'info'} .= ", is in incoming!!!"; - } - - if (!exists $pkg{$query}) { - if ($query eq "suggests") { - $pkg{$query} = "has no suggestions"; - } elsif ($query eq "conflicts") { - $pkg{$query} = "does not conflict with any other package"; - } elsif ($query eq "depends") { - $pkg{$query} = "does not depend on anything"; - } elsif ($query eq "maint") { - $pkg{$query} = "has no maintainer"; - } else { - $pkg{$query} = "has nothing about $query"; - } - } - - &::performStrictReply("$package: $pkg{$query}"); -} - -# Usage: &infoStats($dist); -sub infoStats { - my ($dist) = @_; - $dist = &getDistro($dist); - return unless (defined $dist); - - &::DEBUG("deb: infoS: dist => '$dist'."); - - # download packages file if needed. - my %urls = &fixDist($dist, %urlpackages); - &::DEBUG("deb: download 4."); - if (!&DebianDownload($dist, %urls)) { - &::WARN("Debian(iS): could not download ANY files."); - &::msg($::who, "Debian(iS): internal error."); - return; - } - - my %stats; - my %total = (count => 0, maint => 0, isize => 0, csize => 0); - my $file; - foreach $file (keys %urlpackages) { - $file =~ s/##DIST/$dist/g; # won't work for incoming. - &::DEBUG("deb: file => '$file'."); - if (exists $stats{$file}{'count'}) { - &::DEBUG("deb: hrm... duplicate open with $file???"); - next; - } - - open(IN, "zcat $debian_dir/$file 2>&1 |"); - - if (! -e "$debian_dir/$file") { - &::DEBUG("deb: iS: $debian_dir/$file does not exist."); - next; - } - - while (!eof IN) { - $_ = ; - - next if (/^ \S+/); # package long description. - - if (/^Package: (.*)\n$/) { # counter. - $stats{$file}{'count'}++; - $total{'count'}++; - } elsif (/^Maintainer: .* <(\S+)>$/) { - $stats{$file}{'maint'}{$1}++; - $total{'maint'}{$1}++; - } elsif (/^Size: (.*)$/) { # compressed size. - $stats{$file}{'csize'} += $1; - $total{'csize'} += $1; - } elsif (/^i.*size: (.*)$/i) { # installed size. - $stats{$file}{'isize'} += $1; - $total{'isize'} += $1; - } - -### &::DEBUG("=> '$_'."); - } - close IN; - } - - ### TODO: don't count ppl with multiple email addresses. - - &::performStrictReply( - "Debian Distro Stats on $dist... ". - "\002$total{'count'}\002 packages, ". - "\002".scalar(keys %{ $total{'maint'} })."\002 maintainers, ". - "\002". int($total{'isize'}/1024)."\002 MB installed size, ". - "\002". int($total{'csize'}/1024/1024)."\002 MB compressed size." - ); - -### TODO: do individual stats? if so, we need _another_ arg. -# foreach $file (keys %stats) { -# foreach (keys %{ $stats{$file} }) { -# &::DEBUG(" '$file' '$_' '$stats{$file}{$_}'."); -# } -# } - - return; -} - -### -# HELPER FUNCTIONS FOR INFOPACKAGES... -### - -# Usage: &generateIndex(); -sub generateIndex { - my (@dists) = @_; - &::DEBUG("D: generateIndex($dists[0]) called!"); - if (!scalar @dists or $dists[0] eq '') { - &::ERROR("gI: no dists to generate index."); - return 1; - } - - foreach (@dists) { - my $dist = &getDistro($_); # incase the alias is returned, possible? - my $idx = $debian_dir."/Packages-$dist.idx"; - - # TODO: check if any of the Packages file have been updated then - # regenerate it, even if it's not stale. - # TODO: also, regenerate the index if the packages file is newer - # than the index. - next unless (&::isStale($idx, $refresh)); - - if (/^incoming$/i) { - &::DEBUG("deb: gIndex: calling generateIncoming()!"); - &generateIncoming(); - next; - } - - if (/^woody$/i) { - &::DEBUG("deb: Copying old index of woody to -old"); - system("cp $idx $idx-old"); - } - - &::DEBUG("deb: gIndex: calling DebianDownload($dist, ...).") if ($debug); - &DebianDownload($dist, &fixDist($dist, %urlpackages) ); - - &::status("Debian: generating index for '$dist'."); - if (!open OUT, ">$idx") { - &::ERROR("cannot write to $idx."); - return 0; - } - - my $packages; - foreach $packages (keys %urlpackages) { - $packages =~ s/##DIST/$dist/; - $packages = "$debian_dir/$packages"; - - if (! -e $packages) { - &::ERROR("gIndex: '$packages' does not exist?"); - next; - } - - print OUT "*$packages\n"; - open(IN,"zcat $packages |"); - - while () { - next unless (/^Package: (.*)\n$/); - print OUT $1."\n"; - } - close IN; - } - close OUT; - } - - return 1; -} - -# Usage: &validPackage($package, $dist); -sub validPackage { - my ($package,$dist) = @_; - my @files; - my $file; - - ### this majorly sucks, we need some standard in place. - # why is this needed... need to investigate later. - my $olddist = $dist; - $dist = &getDistro($dist); - - &::DEBUG("deb: validPackage($package, $dist) called.") if ($debug); - - my $error = 0; - while (!open IN, $debian_dir."/Packages-$dist.idx") { - if ($error) { - &::ERROR("Packages-$dist.idx does not exist (#1)."); - return; - } - - &generateIndex($dist); - - $error++; - } - - my $count = 0; - while () { - if (/^\*(.*)\n$/) { - $file = $1; - next; - } - - if (/^\Q$package\E\n$/) { - push(@files,$file); - } - $count++; - } - close IN; - - &::VERB("vP: scanned $count items in index.",2); - - return @files; -} - -sub searchPackage { - my ($dist, $query) = &getDistroFromStr($_[0]); - my $file = $debian_dir."/Packages-$dist.idx"; - my $warn = ($query =~ tr/A-Z/a-z/) ? 1 : 0; - my $error = 0; - my @files; - - &::status("Debian: Search package matching '$query' in '$dist'."); - unlink $file if ( -z $file ); - - while (!open IN, $file) { - if ($dist eq "incoming") { - &::DEBUG("deb: sP: dist == incoming; calling gI()."); - &generateIncoming(); - } - - if ($error) { - &::ERROR("could not generate index ($file)!"); - return; - } - - $error++; - &::DEBUG("deb: should we be doing this?"); - &generateIndex(($dist)); - } - - while () { - chop; - - if (/^\*(.*)$/) { - $file = $1; - - if (&::isStale($file, $refresh)) { - &::DEBUG("deb: STALE $file! regen.") if ($debug); - &generateIndex(($dist)); -### @files = searchPackage("$query $dist"); - &::DEBUG("deb: EVIL HACK HACK HACK.") if ($debug); - last; - } - - next; - } - - if (/\Q$query\E/) { - push(@files,$_); - } - } - close IN; - - if (scalar @files and $warn) { - &::msg($::who, "searching for package name should be fully lowercase!"); - } - - return @files; -} - -sub getDistro { - my $dist = $_[0]; - - if (!defined $dist or $dist eq "") { - &::DEBUG("deb: gD: dist == NULL; dist = defaultdist."); - $dist = $defaultdist; - } - - if ($dist =~ /^(slink|hamm|rex|bo)$/i) { - &::DEBUG("deb: deprecated version ($dist)."); - &::msg($::who, "Debian: deprecated distribution version."); - return; - } - - if (exists $dists{$dist}) { - &::VERB("gD: returning dists{$dist} ($dists{$dist})",2); - return $dists{$dist}; - - } else { - if (!grep /^\Q$dist\E$/i, %dists) { - &::msg($::who, "invalid dist '$dist'."); - return; - } - - &::VERB("gD: returning $dist (no change or conversion)",2); - return $dist; - } -} - -sub getDistroFromStr { - my ($str) = @_; - my $dists = join '|', %dists; - my $dist = $defaultdist; - - if ($str =~ s/\s+($dists)$//i) { - $dist = &getDistro(lc $1); - $str =~ s/\\+$//; - } - $str =~ s/\\([\$\^])/$1/g; - - return($dist,$str); -} - -sub fixDist { - my ($dist, %urls) = @_; - my %new; - my ($key,$val); - - while (($key,$val) = each %urls) { - $key =~ s/##DIST/$dist/; - $val =~ s/##DIST/$dist/; - ### TODO: what should we do if the sar wasn't done. - $new{$debian_dir."/".$key} = $val; - } - - return %new; -} - -sub DebianFind { - # HACK! HACK! HACK! - my ($str) = @_; - my ($dist, $query) = &getDistroFromStr($str); - my @results = sort &searchPackage($str); - - if (!scalar @results) { - &::Forker("Debian", sub { &searchContents($str); } ); - } elsif (scalar @results == 1) { - &::status("searchPackage returned one result; getting info of package instead!"); - &::Forker("Debian", sub { &infoPackages("info", "$results[0] $dist"); } ); - } else { - my $prefix = "Debian Package Listing of '$query' "; - &::performStrictReply( &::formListReply(0, $prefix, @results) ); - } -} - -sub debianCheck { - my $error = 0; - - &::status("debianCheck() called."); - - ### TODO: remove the following loop (check if dir exists before) - while (1) { - last if (opendir(DEBIAN, $debian_dir)); - - if ($error) { - &::ERROR("dC: cannot opendir debian."); - return; - } - - mkdir $debian_dir, 0755; - $error++; - } - - my $retval = 0; - my $file; - while (defined($file = readdir DEBIAN)) { - next unless ($file =~ /(gz|bz2)$/); - - # TODO: add bzip2 support (debian doesn't do .bz2 anyway) - #my $exit = system("/bin/gzip -t '$debian_dir/$file'"); - #next unless ($exit); - &::DEBUG("deb: hmr... => ".(time() - (stat($file))[8])."'."); - next unless (time() - (stat($file))[8] > 3600); - - #&::DEBUG("deb: dC: exit => '$exit'."); - &::WARN("dC: '$debian_dir/$file' corrupted? deleting!"); - unlink $debian_dir."/".$file; - $retval++; - } - - return $retval; -} - -sub checkEval { - my($str) = @_; - - if ($str) { - &::WARN("cE: $str"); - return 0; - } else { - return 1; - } -} - -sub searchDescFE { -# &::DEBUG("deb: FE called for searchDesc"); - my ($query) = @_; - my @list = &searchDesc($query); - - if (!scalar @list) { - my $prefix = "Debian Desc Search of '$query' "; - &::performStrictReply( &::formListReply(0, $prefix, ) ); - } elsif (scalar @list == 1) { # list = 1. - &::DEBUG("deb: list == 1; showing package info of '$list[0]'."); - &infoPackages("info", $list[0]); - } else { # list > 1. - my $prefix = "Debian Desc Search of '$query' "; - &::performStrictReply( &::formListReply(0, $prefix, @list) ); - } -} - -1; diff --git a/blootbot/src/Modules/DebianExtra.pl b/blootbot/src/Modules/DebianExtra.pl deleted file mode 100644 index 8200d45..0000000 --- a/blootbot/src/Modules/DebianExtra.pl +++ /dev/null @@ -1,183 +0,0 @@ -# -# DebianExtra.pl: Extra stuff for debian -# Author: dms -# Version: v0.1 (20000520) -# Created: 20000520 -# - -use strict; - -package DebianExtra; - -sub Parse { - my($args) = @_; - my($msg) = ''; - - #&::DEBUG("DebianExtra: $args\n"); - if (!defined $args or $args =~ /^$/) { - $msg = &debianBugs(); - } elsif ($args =~ /^(\d+)$/) { - # package number: - $msg = &do_id($args); - } elsif ($args =~ /^(\S+\@\S+)$/) { - # package email maintainer. - $msg = &do_email($args); - } elsif ($args =~ /^(\S+)$/) { - # package name. - $msg = &do_pkg($args); - } else { - # invalid. - $msg = "error: could not parse $args"; - } - &::performStrictReply($msg); -} - -sub debianBugs { - my @results = &::getURL("http://master.debian.org/~wakkerma/bugs"); - my ($date, $rcbugs, $remove); - my ($bugs_closed, $bugs_opened) = (0,0); - - if (scalar @results) { - foreach (@results) { - s/<.*?>//g; - $date = $1 if (/status at (.*)\s*$/); - $rcbugs = $1 if (/bugs: (\d+)/); - $remove = $1 if (/REMOVE\S+ (\d+)\s*$/); - if (/^(\d+) r\S+ b\S+ w\S+ c\S+ a\S+ (\d+)/) { - $bugs_closed = $1; - $bugs_opened = $2; - } - } - my $xtxt = ($bugs_closed >=$bugs_opened) ? - "It's good to see " : - "Oh no, the bug count is rising -- "; - - &::performStrictReply( - "Debian bugs statistics, last updated on $date... ". - "There are \002$rcbugs\002 release-critical bugs; $xtxt". - "\002$bugs_closed\002 bugs closed, opening \002$bugs_opened\002 bugs. ". - "About \002$remove\002 packages will be removed." - ); - } else { - &::msg($::who, "Couldn't retrieve data for debian bug stats."); - } -} - -sub do_id($){ - my ($bug_num) = shift; - - if (not $bug_num =~ /^\#?\d+$/) { - return "Bug is not a number!"; - } - $bug_num =~ s/^\#//; - my @results = &::getURL("http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=$bug_num"); - my $report = join("\n", @results); - - # strip down report to relevant header information. - $report =~ s/\r//sig; - $report =~ /]*>(.+?)
/si; - $report = $1; - my $bug = {}; - ($bug->{num}, $bug->{title}) = $report =~ m#\#(\d+)\<\/A\>\(.+?)\<\/H1\>#is; - &::DEBUG("Bugnum: $bug->{num}\n"); - $bug->{title} =~ s/</\{title} =~ s/>/\>/g; - $bug->{title} =~ s/"/\"/g; - &::DEBUG("Title: $bug->{title}\n"); - $bug->{severity} = 'n'; #Default severity is normal - my @bug_flags = split /(?{severity}) = $bug_flag =~ /(wishlist|minor|normal|important|serious|grave)/i; - # Just leave the leter instead of the whole thing. - $bug->{severity} =~ s/^(.).+$/$1/; - } - elsif ($bug_flag =~ /Package:/) { - ($bug->{package}) = $bug_flag =~ /\"\>\s*([^<>]+?)\s*\<\/a\>/; - # take packagename out of title if it's there - $bug->{title} =~ s/^$bug->{package}: //; - } - elsif ($bug_flag =~ /Reported by:/) { - ($bug->{reporter}) = $bug_flag =~ /\"\>\s*(.+?)\s*\<\/a\>/; - # strip < and > - $bug->{reporter} =~ s/</\{reporter} =~ s/>/\>/g; - } - elsif ($bug_flag =~ /Date:/) { - ($bug->{date}) = $bug_flag =~ /Date:\s*(\w.+?)\s*$/; - #ditch extra whitespace - $bug->{date} =~ s/\s{2,}/\ /; - } - elsif ($bug_flag =~ /Tags:/) { - ($bug->{tags}) = $bug_flag =~ /strong\>\s*(.+?)\s*\<\/strong\>/; - } - elsif ($bug_flag =~ /merged with /) { - $bug_flag =~ s/merged with\s*//; - $bug_flag =~ s/\<[^\>]+\>//g; - $bug_flag =~ s/\s//sg; - $bug->{merged_with} = $bug_flag; - - } - elsif ($bug_flag =~ /\>Done:\{done} = 1; - } - } - - # report bug - - $report = ''; - $report .= 'DONE:' if defined $bug->{done} and $bug->{done}; - $report .= '#'.$bug->{num}.':'.uc($bug->{severity}).'['.$bug->{package}.'] '.$bug->{title}; - $report .= ' ('.$bug->{tags}.')' if defined $bug->{tags}; - $report .= ' ' . $bug->{date}; - # Avoid reporting so many merged bugs. - $report .= ' ['.join(',',splice(@{[split(/,/,$bug->{merged_with})]},0,3)).']' if defined $bug->{merged_with}; - if ($::DEBUG) { - use Data::Dumper; - &::DEBUG(Dumper($bug)); - } - return $report; -} - -sub old_do_id { - my($num) = @_; - my $url = "http://bugs.debian.org/$num"; - - # FIXME - return "do_id not supported yet."; - - my @results = &::getURL($url); - foreach (@results) { - &::DEBUG("do_id: $_"); - } -} - -sub do_email { - my($email) = @_; - my $url = "http://bugs.debian.org/$email"; - - # FIXME - return "do_email not supported yet."; - - my @results = &::getURL($url); - foreach (@results) { - &::DEBUG("do_email: $_"); - } -} - -sub do_pkg { - my($pkg) = @_; - my $url = "http://bugs.debian.org/$pkg"; - - # FIXME - return "do_pkg not supported yet."; - - my @results = &::getURL($url); - foreach (@results) { - &::DEBUG("do_pkg: $_"); - } -} - -1; diff --git a/blootbot/src/Modules/Dict.pl b/blootbot/src/Modules/Dict.pl deleted file mode 100644 index 8fccf13..0000000 --- a/blootbot/src/Modules/Dict.pl +++ /dev/null @@ -1,184 +0,0 @@ -# -# Dict.pl: Frontend to dict.org. -# Author: dms -# Version: v0.6c (20000924). -# Created: 19990914. -# Updates: Copyright (c) 2005 - Tim Riker -# -# see http://luetzschena-stahmeln.de/dictd/ -# for a list of dict servers - -package Dict; - -use IO::Socket; -use strict; - -#use vars qw(PF_INET); - -# need a specific host||ip. -my $server = "dict.org"; - -sub Dict { - my ($query) = @_; -# return unless &::loadPerlModule("IO::Socket"); - my $port = 2628; - my $proto = getprotobyname('tcp'); - my @results; - my $retval; - - for ($query) { - s/^[\s\t]+//; - s/[\s\t]+$//; - s/[\s\t]+/ /; - } - - # connect. - # TODO: make strict-safe constants... so we can defer IO::Socket load. - my $socket = new IO::Socket; - socket($socket, PF_INET, SOCK_STREAM, $proto) or return "error: socket: $!"; - eval { - local $SIG{ALRM} = sub { die 'alarm' }; - alarm 10; - connect($socket, sockaddr_in($port, inet_aton($server))) or die "error: connect: $!"; - alarm 0; - }; - - if ($@) { - # failure. - $retval = "i could not get info from $server '$@'"; - } else { # success. - $socket->autoflush(1); # required. - - my $num; - if ($query =~ s/^(\d+)\s+//) { - $num = $1; - } - my $dict = '*'; - if ($query =~ s/\/(\S+)$//) { - $dict = $1; - } - - # body. - push(@results, &Define($socket,$query,$dict)); - #push(@results, &Define($socket,$query,'foldoc')); - #push(@results, &Define($socket,$query,'web1913')); - # end. - - print $socket "QUIT\n"; - close $socket; - - my $count=0; - foreach (@results) { - $count++; - &::DEBUG("$count: $_"); - } - my $total = scalar @results; - - if ($total == 0) { - $num = undef; - } - - if (defined $num and ($num > $total or $num < 1)) { - &::msg($::who, "error: choice in definition is out of range."); - return; - } - - # parse the results. - if ($total > 1) { - if (defined $num) { - $retval = sprintf("[%d/%d] %s", $num, $total, $results[$num-1]); - } else { - # suggested by larne and others. - my $prefix = "Dictionary '$query' "; - $retval = &::formListReply(1, $prefix, @results); - } - } elsif ($total == 1) { - $retval = "Dictionary '$query' ".$results[0]; - } else { - $retval = "could not find definition for \002$query\002"; - $retval .= " in $dict" if ($dict ne '*'); - } - } - - &::performStrictReply($retval); -} - -sub Define { - my ($socket, $query, $dict) = @_; - my @results; - - &::DEBUG("Dict: asking $dict."); - print $socket "DEFINE $dict \"$query\"\n"; - - my $def = ''; - my $term = $query; - - while (<$socket>) { - chop; # remove \n - chop; # remove \r - - &::DEBUG("$term/$dict '$_'"); - if (/^552 /) { - # no match. - return; - } elsif (/^250 /) { - # end w/ optional stats - last; - } elsif (/^151 "([^"]*)" (\S+) .*/) { - # 151 "Good Thing" jargon "Jargon File (4.3.0, 30 APR 2001)" - $term=$1; - $dict=$2; - $def = ''; - &::DEBUG("term=$term dict=$dict"); - } else { - my $line = $_; - # some dicts put part of the definition on the same line ie: jargon - $line =~ s/^$term//i; - $line =~ s/^\s+/ /; - if ($dict eq 'wn') { - # special processing for sub defs in wordnet - if ($line eq '.') { - # end of def. - $def =~ s/\s+$//; - $def =~ s/\[[^\]]*\]//g; - push(@results, $def); - } elsif ($line =~ m/^\s+(\S+ )?(\d+)?: (.*)/) { - # start of sub def. - my $text = $3; - $def =~ s/\s+$//; - #&::DEBUG("def => '$def'."); - $def =~ s/\[[^\]]*\]//g; - push(@results, $def) if ($def ne ''); - $def = $text; - } elsif (/^\s+(.*)/) { - $def .= $line; - } else { - &::DEBUG("ignored '$line'"); - } - } else { - # would be nice to divide other dicts - # but many are not always in a parsable format - if ($line eq '.') { - # end of def. - next if ($def eq ''); - push(@results, $def); - $def = ''; - } elsif ($line =~ m/^\s+(\S.*\S)\s*$/) { - #&::DEBUG("got '$1'"); - $def .= ' ' if ($def ne ''); - $def .= $1; - } else { - &::DEBUG("ignored '$line'"); - } - } - } - } - - &::DEBUG("Dict: $dict: found ". scalar(@results) ." defs."); - - return if (!scalar @results); - - return @results; -} - -1; diff --git a/blootbot/src/Modules/DumpVars.pl b/blootbot/src/Modules/DumpVars.pl deleted file mode 100644 index 80037b0..0000000 --- a/blootbot/src/Modules/DumpVars.pl +++ /dev/null @@ -1,135 +0,0 @@ -# -# DumpVars.pl: Perl variables dumper. -# Maintained: dms -# Version: v0.1 (20000114) -# Created: 20000114 -# NOTE: Ripped from ActivePerl "asp sample" example. -# - -# FIXME -#use strict; - -#use vars qw(); - -my $countlines = 0; - -sub dumpvarslog { - my ($line) = @_; - if (&IsParam('dumpvarsLogFile')) { - print DUMPVARS $line."\n"; - } else { - &status("DV: ".$line); - } -} - -sub DumpNames(\%$) { - my ($package,$packname) = @_; - my $symname = 0; - my $line; - - if ($packname eq 'main::') { - &dumpvarslog('Packages'); - - foreach $symname (sort keys %$package) { - local *sym = $$package{$symname}; - next unless (defined %sym); - next unless ($symname =~/::/); - &dumpvarslog(" $symname"); - $countlines++; - } - } - - # Scalars. - foreach $symname (sort keys %$package) { - local *sym = $$package{$symname}; - next unless (defined $sym); - - my $line; - if (length($sym) > 512) { - &dumpvarslog("Scalar '$packname' $symname too long."); - } else { - &dumpvarslog("Scalar '$packname' \$ $symname => '$sym'"); - } - $countlines++; - } - - # Functions. - foreach $symname (sort keys %$package) { - local *sym = $$package{$symname}; - next unless (defined &sym); - - &dumpvarslog("Function '$packname' $symname()"); - $countlines++; - } - - # Lists. - foreach $symname (sort keys %$package) { - local *sym = $$package{$symname}; - next unless (defined @sym); - - &dumpvarslog("List '$packname' \@$symname (". scalar(@{$symname}) .")"); - $countlines++; - - next unless ($packname eq 'main::'); - foreach (@{$symname}) { - if (defined $_) { - &dumpvarslog(" => '$_'."); - } else { - &dumpvarslog(" => ."); - } - } - } - - # Hashes. - foreach $symname (sort keys %$package) { - local *sym = $$package{$symname}; - next unless (defined %sym); - next if ($symname =~/::/); - - &dumpvarslog("Hash '$packname' \%$symname"); - $countlines++; - - next unless ($packname eq 'main::'); - foreach (keys %{$symname}) { - my $val = ${$symname}{$_}; - if (defined $val) { - &dumpvarslog(" $_ => '$val'."); - } else { - &dumpvarslog(" $_ => ."); - } - } - } - - return unless ($packname eq 'main::'); - - foreach $symname (sort keys %$package) { - local *sym = $$package{$symname}; - next unless (defined %sym); - next unless ($symname =~/::/); - next if ($symname eq 'main::'); - - DumpNames(\%sym,$symname) - } -} - -sub dumpallvars { - if (&IsParam('dumpvarsLogFile')) { - my $file = $param{'dumpvarsLogFile'}; - &status("opening fh to dumpvars ($file)"); - if (!open(DUMPVARS,">$file")) { - &ERROR("cannot open dumpvars."); - return; - } - } - - DumpNames(%main::,'main::'); - - if (&IsParam('dumpvarsLogFile')) { - &status("closing fh to dumpvars"); - close DUMPVARS; - } - - &status("DV: count == $countlines"); -} - -1; diff --git a/blootbot/src/Modules/DumpVars2.pl b/blootbot/src/Modules/DumpVars2.pl deleted file mode 100644 index 2049846..0000000 --- a/blootbot/src/Modules/DumpVars2.pl +++ /dev/null @@ -1,66 +0,0 @@ -# -# DumpVars2.pl: Perl variables dumper ][. -# Maintained: dms -# Version: v0.1 (20020329) -# Created: 20020329 -# - -# use strict; # TODO - -use Devel::Symdump; - -sub symdumplog { - my ($line) = @_; - - if (fileno SYMDUMP) { - print SYMDUMP $line."\n"; - } else { - &status("SD: ".$line); - } -} - -sub symdumpAll { - my $o = Devel::Symdump->rnew(); - - # scalars. - foreach ($o->scalars) { -# &symdumpRecur($_); - symdumplog(" scalar($_)"); - } -} - -sub symdumpRecur { - my $x = shift; - - if (ref $x eq 'HASH') { - foreach (keys %$x) { - &symdumpRecur($_); - } - } else { - symdumplog("unknown: $x"); - } -} - -sub symdumpAllFile { - &DEBUG('before open'); - if (&IsParam('symdumpLogFile')) { - my $file = $param{'symdumpLogFile'}; - &status("opening fh to symdump ($file)"); - if (!open(SYMDUMP,">$file")) { - &ERROR('cannot open dumpvars.'); - return; - } - } - &DEBUG('after open'); - - symdumpAll(); - - if (fileno SYMDUMP) { - &status('closing fh to symdump'); - close SYMDUMP; - } - - &status("SD: count == $countlines"); -} - -1; diff --git a/blootbot/src/Modules/Exchange.pl b/blootbot/src/Modules/Exchange.pl deleted file mode 100644 index e61fa74..0000000 --- a/blootbot/src/Modules/Exchange.pl +++ /dev/null @@ -1,424 +0,0 @@ -#!/usr/bin/perl - -# Exchange.pl - currency exchange 'module' -# -# Last update: 990818 08:30:10, bobby@bofh.dk -# 20021111 Tim Riker -# - -package Exchange; -use strict; - -my $no_exchange; - -BEGIN { - eval qq{ - use LWP::UserAgent; - use HTTP::Request::Common qw(POST GET); - }; - - $no_exchange++ if ($@); -} - -sub GetAbb { - my($LookFor,%Hash) = @_; - - my $Found = (grep /$LookFor/i, keys %Hash)[0]; - $Found =~ m/\((\w\w\w)\)/; - return $1; -} - -sub GetTlds { - my %Hash = ( - 'AF', 'AFGHANISTAN', - 'AL', 'ALBANIA', - 'DZ', 'ALGERIA', - 'AS', 'AMERICAN SAMOA', - 'AD', 'ANDORRA', - 'AO', 'ANGOLA', - 'AI', 'ANGUILLA', - 'AQ', 'ANTARCTICA', - 'AG', 'ANTIGUA AND BARBUDA', - 'AR', 'ARGENTINA', - 'AM', 'ARMENIA', - 'AW', 'ARUBA', - 'AU', 'AUSTRALIA', - 'AT', 'AUSTRIA', - 'AZ', 'AZERBAIJAN', - 'BS', 'BAHAMAS', - 'BH', 'BAHRAIN', - 'BD', 'BANGLADESH', - 'BB', 'BARBADOS', - 'BY', 'BELARUS', - 'BE', 'BELGIUM', - 'BZ', 'BELIZE', - 'BJ', 'BENIN', - 'BM', 'BERMUDA', - 'BT', 'BHUTAN', - 'BO', 'BOLIVIA', - 'BA', 'BOSNIA AND HERZEGOWINA', - 'BW', 'BOTSWANA', - 'BV', 'BOUVET ISLAND', - 'BR', 'BRAZIL', - 'IO', 'BRITISH INDIAN OCEAN TERRITORY', - 'BN', 'BRUNEI DARUSSALAM', - 'BG', 'BULGARIA', - 'BF', 'BURKINA FASO', - 'BI', 'BURUNDI', - 'KH', 'CAMBODIA', - 'CM', 'CAMEROON', - 'CA', 'CANADA', - 'CV', 'CAPE VERDE', - 'KY', 'CAYMAN ISLANDS', - 'CF', 'CENTRAL AFRICAN REPUBLIC', - 'TD', 'CHAD', - 'CL', 'CHILE', - 'CN', 'CHINA', - 'CX', 'CHRISTMAS ISLAND', - 'CC', 'COCOS (KEELING) ISLANDS', - 'CO', 'COLOMBIA', - 'KM', 'COMOROS', - 'CG', 'CONGO', - 'CD', 'CONGO, THE DEMOCRATIC REPUBLIC OF THE', - 'CK', 'COOK ISLANDS', - 'CR', 'COSTA RICA', - 'CI', "COTE D'IVOIRE", - 'HR', 'CROATIA (local name: Hrvatska)', - 'CU', 'CUBA', - 'CY', 'CYPRUS', - 'CZ', 'CZECH REPUBLIC', - 'DK', 'DENMARK', - 'DJ', 'DJIBOUTI', - 'DM', 'DOMINICA', - 'DO', 'DOMINICAN REPUBLIC', - 'TP', 'EAST TIMOR', - 'EC', 'ECUADOR', - 'EG', 'EGYPT', - 'SV', 'EL SALVADOR', - 'GQ', 'EQUATORIAL GUINEA', - 'ER', 'ERITREA', - 'EE', 'ESTONIA', - 'ET', 'ETHIOPIA', - 'FK', 'FALKLAND ISLANDS (MALVINAS)', - 'FO', 'FAROE ISLANDS', - 'FJ', 'FIJI', - 'FI', 'FINLAND', - 'FR', 'FRANCE', - 'FX', 'FRANCE, METROPOLITAN', - 'GF', 'FRENCH GUIANA', - 'PF', 'FRENCH POLYNESIA', - 'TF', 'FRENCH SOUTHERN TERRITORIES', - 'GA', 'GABON', - 'GM', 'GAMBIA', - 'GE', 'GEORGIA', - 'DE', 'GERMANY', - 'GH', 'GHANA', - 'GI', 'GIBRALTAR', - 'GR', 'GREECE', - 'GL', 'GREENLAND', - 'GD', 'GRENADA', - 'GP', 'GUADELOUPE', - 'GU', 'GUAM', - 'GT', 'GUATEMALA', - 'GN', 'GUINEA', - 'GW', 'GUINEA-BISSAU', - 'GY', 'GUYANA', - 'HT', 'HAITI', - 'HM', 'HEARD AND MC DONALD ISLANDS', - 'VA', 'HOLY SEE (VATICAN CITY STATE)', - 'HN', 'HONDURAS', - 'HK', 'HONG KONG', - 'HU', 'HUNGARY', - 'IS', 'ICELAND', - 'IN', 'INDIA', - 'ID', 'INDONESIA', - 'IR', 'IRAN (ISLAMIC REPUBLIC OF)', - 'IQ', 'IRAQ', - 'IE', 'IRELAND', - 'IL', 'ISRAEL', - 'IT', 'ITALY', - 'JM', 'JAMAICA', - 'JP', 'JAPAN', - 'JO', 'JORDAN', - 'KZ', 'KAZAKHSTAN', - 'KE', 'KENYA', - 'KI', 'KIRIBATI', - 'KP', "KOREA, DEMOCRATIC PEOPLE'S REPUBLIC OF", - 'KR', 'KOREA, REPUBLIC OF', - 'KW', 'KUWAIT', - 'KG', 'KYRGYZSTAN', - 'LA', "LAO PEOPLE'S DEMOCRATIC REPUBLIC", - 'LV', 'LATVIA', - 'LB', 'LEBANON', - 'LS', 'LESOTHO', - 'LR', 'LIBERIA', - 'LY', 'LIBYAN ARAB JAMAHIRIYA', - 'LI', 'LIECHTENSTEIN', - 'LT', 'LITHUANIA', - 'LU', 'LUXEMBOURG', - 'MO', 'MACAU', - 'MK', 'MACEDONIA, THE FORMER YUGOSLAV REPUBLIC OF', - 'MG', 'MADAGASCAR', - 'MW', 'MALAWI', - 'MY', 'MALAYSIA', - 'MV', 'MALDIVES', - 'ML', 'MALI', - 'MT', 'MALTA', - 'MH', 'MARSHALL ISLANDS', - 'MQ', 'MARTINIQUE', - 'MR', 'MAURITANIA', - 'MU', 'MAURITIUS', - 'YT', 'MAYOTTE', - 'MX', 'MEXICO', - 'FM', 'MICRONESIA, FEDERATED STATES OF', - 'MD', 'MOLDOVA, REPUBLIC OF', - 'MC', 'MONACO', - 'MN', 'MONGOLIA', - 'MS', 'MONTSERRAT', - 'MA', 'MOROCCO', - 'MZ', 'MOZAMBIQUE', - 'MM', 'MYANMAR', - 'NA', 'NAMIBIA', - 'NR', 'NAURU', - 'NP', 'NEPAL', - 'NL', 'NETHERLANDS', - 'AN', 'NETHERLANDS ANTILLES', - 'NC', 'NEW CALEDONIA', - 'NZ', 'NEW ZEALAND', - 'NI', 'NICARAGUA', - 'NE', 'NIGER', - 'NG', 'NIGERIA', - 'NU', 'NIUE', - 'NF', 'NORFOLK ISLAND', - 'MP', 'NORTHERN MARIANA ISLANDS', - 'NO', 'NORWAY', - 'OM', 'OMAN', - 'PK', 'PAKISTAN', - 'PW', 'PALAU', - 'PA', 'PANAMA', - 'PG', 'PAPUA NEW GUINEA', - 'PY', 'PARAGUAY', - 'PE', 'PERU', - 'PH', 'PHILIPPINES', - 'PN', 'PITCAIRN', - 'PL', 'POLAND', - 'PT', 'PORTUGAL', - 'PR', 'PUERTO RICO', - 'QA', 'QATAR', - 'RE', 'REUNION', - 'RO', 'ROMANIA', - 'RU', 'RUSSIAN FEDERATION', - 'RW', 'RWANDA', - 'KN', 'SAINT KITTS AND NEVIS', - 'LC', 'SAINT LUCIA', - 'VC', 'SAINT VINCENT AND THE GRENADINES', - 'WS', 'SAMOA', - 'SM', 'SAN MARINO', - 'ST', 'SAO TOME AND PRINCIPE', - 'SA', 'SAUDI ARABIA', - 'SN', 'SENEGAL', - 'SC', 'SEYCHELLES', - 'SL', 'SIERRA LEONE', - 'SG', 'SINGAPORE', - 'SK', 'SLOVAKIA (Slovak Republic)', - 'SI', 'SLOVENIA', - 'SB', 'SOLOMON ISLANDS', - 'SO', 'SOMALIA', - 'ZA', 'SOUTH AFRICA', - 'GS', 'SOUTH GEORGIA AND THE SOUTH SANDWICH ISLANDS', - 'ES', 'SPAIN', - 'LK', 'SRI LANKA', - 'SH', 'ST. HELENA', - 'PM', 'ST. PIERRE AND MIQUELON', - 'SD', 'SUDAN', - 'SR', 'SURINAME', - 'SJ', 'SVALBARD AND JAN MAYEN ISLANDS', - 'SZ', 'SWAZILAND', - 'SE', 'SWEDEN', - 'CH', 'SWITZERLAND', - 'SY', 'SYRIAN ARAB REPUBLIC', - 'TW', 'TAIWAN, PROVINCE OF CHINA', - 'TJ', 'TAJIKISTAN', - 'TZ', 'TANZANIA, UNITED REPUBLIC OF', - 'TH', 'THAILAND', - 'TG', 'TOGO', - 'TK', 'TOKELAU', - 'TO', 'TONGA', - 'TT', 'TRINIDAD AND TOBAGO', - 'TN', 'TUNISIA', - 'TR', 'TURKEY', - 'TM', 'TURKMENISTAN', - 'TC', 'TURKS AND CAICOS ISLANDS', - 'TV', 'TUVALU', - 'UG', 'UGANDA', - 'UA', 'UKRAINE', - 'AE', 'UNITED ARAB EMIRATES', - 'GB', 'UNITED KINGDOM', - 'US', 'UNITED STATES', - 'UM', 'UNITED STATES MINOR OUTLYING ISLANDS', - 'UY', 'URUGUAY', - 'UZ', 'UZBEKISTAN', - 'VU', 'VANUATU', - 'VE', 'VENEZUELA', - 'VN', 'VIET NAM', - 'VG', 'VIRGIN ISLANDS (BRITISH)', - 'VI', 'VIRGIN ISLANDS (U.S.)', - 'WF', 'WALLIS AND FUTUNA ISLANDS', - 'EH', 'WESTERN SAHARA', - 'YE', 'YEMEN', - 'YU', 'YUGOSLAVIA', - 'ZM', 'ZAMBIA', - 'ZW', 'ZIMBABWE', - ); - return %Hash; -} - -sub exchange { - my ($message) = @_; - &::DEBUG("exchange(@_)"); - - return 'Exchange.pl needs LWP::UserAgent and HTTP::Request::Common' - if ($no_exchange); - - my ($From, $To, $Amount, $Country); - my $retval = ''; - if ($message =~ /^([\d\.\,]+)\s+(\S+)\s+(?:into|to|for)\s+(\S+)/i) { - ($Amount,$From,$To) = ($1,$2,$3); - $From = uc $From; $To = uc $To; - } elsif ($message =~ /^for\s(?:the\s)?([\w\s]+)/i) { - # looking up the currency for a country - $Country = $1; - } else { - return "that doesn't look right"; - } - - my $ua = new LWP::UserAgent; - # Let's pretend - #$ua->agent('Mozilla/5.0 ' . $ua->agent); - $ua->agent('Mozilla/5.0'); - $ua->proxy('http', $::param{'httpProxy'}) if (&::IsParam('httpProxy')); - $ua->timeout(10); - - my $Referer = 'http://www.xe.net/ucc/full.shtml'; - my $Converter='http://www.xe.net/ucc/convert.cgi'; - - # Get a list of currency abbreviations... - my $grab = GET $Referer; - my $reply = $ua->request($grab); - if (!$reply->is_success) { - return 'EXCHANGE: '.$reply->status_line; - } - my $html = $reply->as_string; - my %Currencies = (grep /\S+/, - ($html =~ /option value="([^"]+)">.*?,\s*([^<]+)([^<]+) 'UTC', - From => $From, - To => $To, - Amount => $Amount, - ]; - - # Falsify where we came from - $req->referer($Referer); - - # Submit request - my $res = $ua->request($req); - - if ($res->is_success) { - # Went through ok - my $html = $res->as_string; - # parse each one to avoid undefined warnings - my ($When) = ($html =~ m/ as of (\d{4}\.\d\d.\d\d\s\d\d:\d\d:\d\d\s\S+)/gi); - my ($Cfrom) = ($html =~ m/(\d[\d,.]+)\s*$From/gi); - my ($Cto) = ($html =~ m/(\d[\d,.]+)\s*$To/gi); - #my ($When, $Cfrom, $Cto) = - # grep /\S+/, ($html =~ m/ as of (\d{4}\.\d\d.\d\d\s\d\d:\d\d:\d\d\s\S+)|(\d[\d,.]+)\s*$From|(\d[\d,.]+)\s* $To/gi); - - if ($When) { - return "$Cfrom $Currencies{$From} makes ". - "$Cto $Currencies{$To} (from http://www.xe.com/)"; # ." ($When)\n"; - } else { - return 'i got some error trying that'; - } - } else { - # Oh dear. - return "EXCHANGE: ". $res->status_line; - } - } else { - return "Don't know about \"$From\" as a currency" if (!exists $Currencies{$From}); - return "Don't know about \"$To\" as a currency" if (!exists $Currencies{$To}); - } - } -} - -sub query { - my ($args) = @_; - &::performStrictReply(&exchange($args)); - return; -} - -#print &exchange('1 usd to eur') . "\n"; -1; - -__END__ - -=head1 NAME - -Exchange.pl - Exchange between currencies - -=head1 PREREQUISITES - - LWP::UserAgent - HTTP::Request::Common - -=head1 PARAMETERS - -exchange - -=head1 PUBLIC INTERFACE - - Exchange for|[in]to - -=head1 DESCRIPTION - -Contacts C and grabs the exchange rates; warning - the -currency code is a bit cranky. - -=head1 AUTHORS - -Bobby diff --git a/blootbot/src/Modules/Factoids.pl b/blootbot/src/Modules/Factoids.pl deleted file mode 100644 index 89a6934..0000000 --- a/blootbot/src/Modules/Factoids.pl +++ /dev/null @@ -1,748 +0,0 @@ -# -# Factoids.pl: Helpers for generating factoids statistics. -# Author: dms -# Version: v0.1 (20000514) -# Splitted: SQLExtras.pl -# - -use strict; - -use vars qw($dbh $who); -use vars qw(%param); - -### -# Usage: &CmdFactInfo($faqtoid, $query); -sub CmdFactInfo { - my ($faqtoid, $query) = (lc $_[0], $_[1]); - my @array; - my $string = ''; - - if ($faqtoid eq '') { - &help('factinfo'); - return; - } - - my %factinfo = &sqlSelectRowHash('factoids', '*', - { factoid_key => $faqtoid } - ); - - # factoid does not exist. - if (scalar (keys %factinfo) <= 1) { - &performReply("there's no such factoid as \002$faqtoid\002"); - return; - } - - # fix for problem observed by asuffield. - # why did it happen though? - if (!$factinfo{'factoid_value'}) { - &performReply("there's no such factoid as \002$faqtoid\002; deleted because we don't have factoid_value!"); - foreach (keys %factinfo) { - &DEBUG("factinfo{$_} => '$factinfo{$_}'."); - } -### &delFactoid($faqtoid); - return; - } - - # created: - if ($factinfo{'created_by'}) { - - $factinfo{'created_by'} =~ s/\!/ '; - $string = "created by $factinfo{'created_by'}"; - - my $time = $factinfo{'created_time'}; - if ($time) { - if (time() - $time > 60*60*24*7) { - my $days = int( (time() - $time)/60/60/24 ); - $string .= " at \037". scalar(gmtime $time). "\037" . - " ($days days)"; - } else { - $string .= ' '.&Time2String(time() - $time).' ago'; - } - } - - push(@array,$string); - } - - # modified: (TimRiker asks: why do you keep turning this off?) - if ($factinfo{'modified_by'}) { - $string = 'last modified'; - - my $time = $factinfo{'modified_time'}; - if ($time) { - if (time() - $time > 60*60*24*7) { - $string .= " at \037". scalar(gmtime $time). "\037"; - } else { - $string .= ' '.&Time2String(time() - $time).' ago '; - } - } - - $string .= ' by '.(split ',', $factinfo{'modified_by'})[0]; - - push(@array,$string); - } - - # requested: - if ($factinfo{'requested_by'}) { - my $requested_count = $factinfo{'requested_count'}; - - if ($requested_count) { - $string = 'it has been requested '; - if ($requested_count == 1) { - $string .= "\002once\002"; - } else { - $string .= "\002". $requested_count. "\002 ". - &fixPlural('time', $requested_count); - } - - my $requested_by = $factinfo{'requested_by'}; - $requested_by =~ /\!/; - $string .= ", last by $`"; - - my $requested_time = $factinfo{'requested_time'}; - if ($requested_time) { - if (time() - $requested_time > 60*60*24*7) { - $string .= " at \037". scalar(localtime $requested_time). "\037"; - } else { - $string .= ', '.&Time2String(time() - $requested_time).' ago'; - } - } - } else { - $string = 'has not been requested yet'; - } - - push(@array, $string); - } - - # locked: - if ($factinfo{'locked_by'}) { - $factinfo{'locked_by'} =~ /\!/; - $string = "it has been locked by $`"; - - push(@array, $string); - } - - # factoid was inserted not through the bot. - if (!scalar @array) { - &performReply("no extra info on \002$faqtoid\002"); - return; - } - - &performStrictReply("$factinfo{'factoid_key'} -- ". join('; ', @array) .'.'); - return; -} - -sub CmdFactStats { - my ($type) = @_; - - if ($type =~ /^author$/i) { - my %hash = &sqlSelectColHash('factoids', - 'factoid_key,created_by', undef, - 'WHERE created_by IS NOT NULL' - ); - my %author; - - foreach my $factoid (keys %hash) { - my $thisnuh = $hash{$factoid}; - - $thisnuh =~ /^(\S+)!\S+@\S+$/; - $author{lc $1}++; - } - - if (!scalar keys %author) { - return 'sorry, no factoids with created_by field.'; - } - - # work-around. - my %count; - foreach (keys %author) { - $count{ $author{$_} }{$_} = 1; - } - undef %author; - - my $count; - my @list; - foreach $count (sort { $b <=> $a } keys %count) { - my $author = join(', ', sort keys %{ $count{$count} }); - push(@list, "$count by $author"); - } - - my $prefix = 'factoid statistics by author: '; - return &formListReply(0, $prefix, @list); - - } elsif ($type =~ /^vandalism$/i) { - &status('factstats(vandalism): starting...'); - my $start_time = &timeget(); - my %data = &sqlSelectColHash('factoids', - 'factoid_key,factoid_value', undef, - 'WHERE factoid_value IS NOT NULL' - ); - my @list; - - my $delta_time = &timedelta($start_time); - &status(sprintf('factstats(vandalism): %.02f sec to retreive all factoids.', $delta_time)) if ($delta_time > 0); - $start_time = &timeget(); - - # parse the factoids. - foreach (keys %data) { - if (&validFactoid($_, $data{$_}) == 0) { - s/([\,\;]+)/\037$1\037/g; # highlight chars. - push(@list, $_); # push it. - } - } - - $delta_time = &timedelta($start_time); - &status(sprintf('factstats(vandalism): %.02f sec to complete.', $delta_time)) if ($delta_time > 0); - - # bail out on no results. - if (scalar @list == 0) { - return 'no vandalised factoids... wooohoo.'; - } - - # parse the results. - my $prefix = 'Vandalised factoid '; - return &formListReply(1, $prefix, @list); - - } elsif ($type =~ /^total$/i) { - &status('factstats(total): starting...'); - my $start_time = &timeget(); - my @list; - my $str; - my($i,$j); - my %hash; - - ### lets do it. - # total factoids requests. - $i = &sumKey('factoids', 'requested_count'); - push(@list, "total requests - $i"); - - # total factoids modified. - $str = &countKeys('factoids', 'modified_by'); - push(@list, "total modified - $str"); - - # total factoids modified. - $j = &countKeys('factoids', 'requested_count'); - $str = &countKeys('factoids', 'factoid_key'); - push(@list, 'total non-requested - '.($str - $i)); - - # average request/factoid. - # i/j == total(requested_count)/count(requested_count) - $str = sprintf('%.01f', $i/$j); - push(@list, "average requested per factoid - $str"); - - # total prepared for deletion. - $str = scalar( &searchTable('factoids', 'factoid_key', 'factoid_value', ' #DEL') ); - push(@list, "total prepared for deletion - $str"); - - # total unique authors. - # TODO: convert to sqlSelectColHash ? (or ColArray?) - foreach ( &sqlRawReturn('SELECT created_by FROM factoids WHERE created_by IS NOT NULL') ) { - /^(\S+)!/; - my $nick = lc $1; - $hash{$nick}++; - } - push(@list, 'total unique authors - '.(scalar keys %hash) ); - undef %hash; - - # total unique requesters. - foreach ( &sqlRawReturn('SELECT requested_by FROM factoids WHERE requested_by IS NOT NULL') ) { - /^(\S+)!/; - my $nick = lc $1; - $hash{$nick}++; - } - push(@list, 'total unique requesters - '.(scalar keys %hash) ); - undef %hash; - - ### end of 'job'. - - my $delta_time = &timedelta($start_time); - &status(sprintf('factstats(broken): %.02f sec to retreive all factoids.', $delta_time)) if ($delta_time > 0); - $start_time = &timeget(); - - # bail out on no results. - if (scalar @list == 0) { - return 'no broken factoids... wooohoo.'; - } - - # parse the results. - my $prefix = 'General factoid statistics '; - return &formListReply(1, $prefix, @list); - - } elsif ($type =~ /^deadredir$/i) { - my @list = &searchTable('factoids', 'factoid_key', - 'factoid_value', '^ see '); - my %redir; - my $f; - - for (@list) { - my $factoid = $_; - my $val = &getFactInfo($factoid, 'factoid_value'); - if ($val =~ /^ ?see( also)? (.*?)\.?$/i) { - my $redirf = lc $2; - my $redir = &getFactInfo($redirf, 'factoid_value'); - next if (defined $redir); - next if (length $val > 50); - - $redir{$redirf}{$factoid} = 1; - } - } - - my @newlist; - foreach $f (keys %redir) { - my @sublist = keys %{ $redir{$f} }; - for (@sublist) { - s/([\,\;]+)/\037$1\037/g; - } - - push(@newlist, join(', ', @sublist)." => $f"); - } - - # parse the results. - my $prefix = 'Loose link (dead) redirections in factoids '; - return &formListReply(1, $prefix, @newlist); - - } elsif ($type =~ /^dup(licate|e)$/i) { - &status('factstats(dupe): starting...'); - my $start_time = &timeget(); - my %hash = &sqlSelectColHash('factoids', - 'factoid_key,factoid_value', undef, - 'WHERE factoid_value IS NOT NULL', 1 - ); - my $refs = 0; - my @list; - my $v; - - foreach $v (keys %hash) { - my $count = scalar(keys %{ $hash{$v} }); - next if ($count == 1); - - my @sublist; - foreach (keys %{ $hash{$v} }) { - if ($v =~ /^ see /i) { - $refs++; - next; - } - - s/([\,\;]+)/\037$1\037/g; - if ($_ eq '') { - &WARN('dupe: _ = NULL. should never happen!.'); - next; - } - push(@sublist, $_); - } - - next unless (scalar @sublist); - - push(@list, join(', ', @sublist)); - } - - &status("factstats(dupe): (good) dupe refs: $refs."); - my $delta_time = &timedelta($start_time); - &status(sprintf('factstats(dupe): %.02f sec to complete', $delta_time)) if ($delta_time > 0); - - # bail out on no results. - if (scalar @list == 0) { - return 'no duplicate factoids... woohoo.'; - } - - # parse the results. - my $prefix = 'dupe factoid '; - return &formListReply(1, $prefix, @list); - - } elsif ($type =~ /^nullfactoids$/i) { - my $query = "SELECT factoid_key,factoid_value FROM factoids WHERE factoid_value=''"; - my $sth = $dbh->prepare($query); - &ERROR("factstats(null): => '$query'.") unless $sth->execute; - - my @list; - while (my @row = $sth->fetchrow_array) { - if ($row[1] ne '') { - &DEBUG("row[1] != NULL for $row[0]."); - next; - } - - &DEBUG("row[0] => '$row[0]'."); - push(@list, $row[0]); - } - $sth->finish; - - # parse the results. - my $prefix = 'NULL factoids (not deleted yet) '; - return &formListReply(1, $prefix, @list); - - } elsif ($type =~ /^(2|too)short$/i) { - # Custom select statement. - my $query = 'SELECT factoid_key,factoid_value FROM factoids WHERE length(factoid_value) <= 40'; - my $sth = $dbh->prepare($query); - &ERROR("factstats(lame): => '$query'.") unless $sth->execute; - - my @list; - while (my @row = $sth->fetchrow_array) { - my($key,$val) = ($row[0], $row[1]); - my $match = 0; - $match++ if ($val =~ /\s{3,}/); - next unless ($match); - - my $v = &getFactoid($val); - if (defined $v) { - &DEBUG("key $key => $val => $v"); - } - - $key =~ s/\,/\037\,\037/g; - push(@list, $key); - } - $sth->finish; - - # parse the results. - my $prefix = 'Lame factoids '; - return &formListReply(1, $prefix, @list); - - } elsif ($type =~ /^listfix$/i) { - # Custom select statement. - my $query = 'SELECT factoid_key,factoid_value FROM factoids'; - my $sth = $dbh->prepare($query); - &ERROR("factstats(listfix): => '$query'.") unless $sth->execute; - - my @list; - while (my @row = $sth->fetchrow_array) { - my($key,$val) = ($row[0], $row[1]); - my $match = 0; - $match++ if ($val =~ /\S+,? or \S+,? or \S+,? or \S+,?/); - next unless ($match); - - $key =~ s/\,/\037\,\037/g; - push(@list, $key); - $val =~ s/,? or /, /g; - &DEBUG("fixed: => $val."); - &setFactInfo($key,'factoid_value', $val); - } - $sth->finish; - - # parse the results. - my $prefix = 'Inefficient lists fixed '; - return &formListReply(1, $prefix, @list); - - } elsif ($type =~ /^locked$/i) { - my %hash = &sqlSelectColHash('factoids', - 'factoid_key,locked_by', undef, - 'WHERE locked_by IS NOT NULL' - ); - my @list = keys %hash; - - for (@list) { - s/([\,\;]+)/\037$1\037/g; - } - - my $prefix = "factoid statistics on $type "; - return &formListReply(0, $prefix, @list); - - } elsif ($type =~ /^new$/i) { - my %hash = &sqlSelectColHash('factoids', - 'factoid_key,created_time', undef, - 'WHERE created_time IS NOT NULL' - ); - my %age; - - foreach (keys %hash) { - my $created_time = $hash{$_}; - my $delta_time = time() - $created_time; - next if ($delta_time >= 60*60*24); - - $age{$delta_time}{$_} = 1; - } - - if (scalar keys %age == 0) { - return 'sorry, no new factoids.'; - } - - my @list; - foreach (sort {$a <=> $b} keys %age) { - push(@list, join(',', keys %{ $age{$_} })); - } - - my $prefix = 'new factoids in the last 24hours '; - return &formListReply(0, $prefix, @list); - - } elsif ($type =~ /^part(ial)?dupe$/i) { - ### requires 'custom' select statement... oh well... - my $start_time = &timeget(); - - # form length|key and key=length hash list. - &status('factstats(partdupe): forming length hash list.'); - my $query = 'SELECT factoid_key,factoid_value,length(factoid_value) AS length FROM factoids WHERE length(factoid_value) >= 192 ORDER BY length'; - my $sth = $dbh->prepare($query); - &ERROR("factstats(partdupe): => '$query'.") unless $sth->execute; - - my (@key, @list); - my (%key, %length); - while (my @row = $sth->fetchrow_array) { - $length{$row[2]}{$row[0]} = 1; # length(value)|key. - $key{$row[0]} = $row[1]; # key=value. - push(@key, $row[0]); - } - $sth->finish; - &status("factstats(partdupe): total keys => '". scalar(@key) ."'."); - &status('factstats(partdupe): now deciphering data gathered'); - - my @length = sort { $a <=> $b } keys %length; - my $key; - - foreach $key (@key) { - shift @length if (length $key{$key} == $length[0]); - - my $val = quotemeta $key{$key}; - my @sublist; - my $length; - foreach $length (@length) { - foreach (keys %{ $length{$length} }) { - if ($key{$_} =~ /^$val/i) { - s/([\,\;]+)/\037$1\037/g; - s/( and|and )/\037$1\037/g; - push(@sublist,$key.' and '.$_); - } - } - } - push(@list, join(' ,',@sublist)) if (scalar @sublist); - } - - my $delta_time = sprintf('%.02fs', &timedelta($start_time) ); - &status("factstats(partdupe): $delta_time sec to complete.") if ($delta_time > 0); - - # bail out on no results. - if (scalar @list == 0) { - return 'no initial partial duplicate factoids... woohoo.'; - } - - # parse the results. - my $prefix = 'initial partial dupe factoid '; - return &formListReply(1, $prefix, @list); - - } elsif ($type =~ /^profanity$/i) { - my %data = &sqlSelectColHash('factoids', - 'factoid_key,factoid_value', undef, - 'WHERE factoid_value IS NOT NULL' - ); - my @list; - - foreach (keys %data) { - push(@list, $_) if (&hasProfanity($_.' '.$data{$_})); - } - - # parse the results. - my $prefix = 'Profanity in factoids '; - return &formListReply(1, $prefix, @list); - - } elsif ($type =~ /^redir(ection)?$/i) { - my @list = &searchTable('factoids', 'factoid_key', - 'factoid_value', '^ see '); - my %redir; - my $f; - my $dangling = 0; - - for (@list) { - my $factoid = $_; - my $val = &getFactInfo($factoid, 'factoid_value'); - if ($val =~ /^ see( also)? (.*?)\.?$/i) { - my $redir = lc $2; - my $redirval = &getFactInfo($redir, 'factoid_value'); - if (defined $redirval) { - $redir{$redir}{$factoid} = 1; - } else { - &DEBUG("factstats(redir): '$factoid' has loose link => '$redir'."); - $dangling++; - } - } - } - - my @newlist; - foreach $f (keys %redir) { - my @sublist = keys %{ $redir{$f} }; - for (@sublist) { - s/([\,\;]+)/\037$1\037/g; - } - - push(@newlist, "$f => ". join(', ', @sublist)); - } - - # parse the results. - my $prefix = "Redirections in factoids, $dangling dangling "; - return &formListReply(1, $prefix, @newlist); - - } elsif ($type =~ /^request(ed)?$/i) { - my %hash = &sqlSelectColHash('factoids', - 'factoid_key,requested_count', undef, - 'WHERE requested_count IS NOT NULL', 1 - ); - - if (!scalar keys %hash) { - return 'sorry, no factoids have been questioned.'; - } - - my $count; - my @list; - my $total = 0; - foreach $count (sort {$b <=> $a} keys %hash) { - my @faqtoids = sort keys %{ $hash{$count} }; - - for (@faqtoids) { - s/([\,\;]+)/\037$1\037/g; - } - $total += $count * scalar(@faqtoids); - - push(@list, "$count - ". join(', ', @faqtoids)); - } - unshift(@list, "\037$total - TOTAL\037"); - - my $prefix = "factoid statistics on $type "; - return &formListReply(0, $prefix, @list); - - } elsif ($type =~ /^reqrate$/i) { - my %hash = &sqlSelectColHash('factoids', - "factoid_key,(unix_timestamp() - created_time)/requested_count as rate", undef, - 'WHERE requested_by IS NOT NULL and created_time IS NOT NULL ORDER BY rate LIMIT 15', 1 - ); - - my $rate; - my @list; - my $total = 0; - my $users = 0; - foreach $rate (sort { $b <=> $a } keys %hash) { - my $f = join(', ', sort keys %{ $hash{$rate} }); - my $str = "$f - ".&Time2String($rate); - $str =~ s/\002//g; - push(@list, $str); - } - - my $prefix = "Rank of top factoid rate (time/req): "; - return &formListReply(0, $prefix, @list); - - } elsif ($type =~ /^requesters?$/i) { - my %hash = &sqlSelectColHash('factoids', - 'factoid_key,requested_by', undef, - 'WHERE requested_by IS NOT NULL' - ); - my %requester; - - foreach (keys %hash) { - my $thisnuh = $hash{$_}; - - $thisnuh =~ /^(\S+)!\S+@\S+$/; - $requester{lc $1}++; - } - - if (!scalar keys %requester) { - return 'sorry, no factoids with requested_by field.'; - } - - # work-around. - my %count; - foreach (keys %requester) { - $count{ $requester{$_} }{$_} = 1; - } - undef %requester; - - my $count; - my @list; - my $total = 0; - my $users = 0; - foreach $count (sort { $b <=> $a } keys %count) { - my $requester = join(', ', sort keys %{ $count{$count} }); - $total += $count * scalar(keys %{ $count{$count} }); - $users += scalar(keys %{ $count{$count} }); - push(@list, "$count by $requester"); - } - unshift(@list, "\037$total TOTAL REQUESTS; $users UNIQUE REQUESTERS\037"); - # should not the above value be the same as collected by - # 'requested'? soemthing weird is going on! - - my $prefix = 'rank of top factoid requesters: '; - return &formListReply(0, $prefix, @list); - - } elsif ($type =~ /^seefix$/i) { - my @list = &searchTable('factoids', 'factoid_key', - 'factoid_value', '^see '); - my @newlist; - my $fixed = 0; - my %loop; - my $f; - - for (@list) { - my $factoid = $_; - my $val = &getFactInfo($factoid, 'factoid_value'); - - next unless ($val =~ /^see( also)? (.*?)\.?$/i); - - my $redirf = lc $2; - my $redir = &getFactInfo($redirf, 'factoid_value'); - - if ($redirf =~ /^\Q$factoid\W$/i) { - &delFactoid($factoid); - $loop{$factoid} = 1; - } - - if (defined $redir) { # good. - &setFactInfo($factoid,'factoid_value'," see $redir"); - $fixed++; - } else { - push(@newlist, $redirf); - } - } - - # parse the results. - &msg($who, "Fixed $fixed factoids."); - &msg($who, 'Self looped factoids removed: '. keys %loop ) if (scalar keys %loop); - - my $prefix = "Loose link (dead) redirections in factoids "; - return &formListReply(1, $prefix, @newlist); - - } elsif ($type =~ /^(2|too)long$/i) { - my @list; - my $query; - - # factoid_key. - $query = "SELECT factoid_key FROM factoids WHERE length(factoid_key) >= $param{'maxKeySize'}"; - my $sth = $dbh->prepare($query); - $sth->execute; - while (my @row = $sth->fetchrow_array) { - push(@list,$row[0]); - } - $sth->finish; - - # factoid_value. - $query = "SELECT factoid_key,factoid_value FROM factoids WHERE length(factoid_value) >= $param{'maxDataSize'}"; - $sth = $dbh->prepare($query); - $sth->execute; - while (my @row = $sth->fetchrow_array) { - push(@list,sprintf("\002%s\002 - %s", length($row[1]), $row[0])); - } - $sth->finish; - - if (scalar @list == 0) { - return 'good. no factoids exceed length.'; - } - - # parse the results. - my $prefix = 'factoid key||value exceeding length '; - return &formListReply(1, $prefix, @list); - - } elsif ($type =~ /^unrequest(ed)?$/i) { - # TODO: use sqlSelect() - my ($count) = &sqlRawReturn("SELECT COUNT(*) FROM factoids WHERE requested_count = '0'"); - - return "Unrequested factoids: $count"; - } - - return "error: invalid type => '$type'."; -} - -sub CmdListAuth { - my ($query) = @_; - my $maxshow = &::getChanConfDefault('maxListReplyCount', 15, $chan); - my @list = &searchTable('factoids','factoid_key', 'created_by', "^$query!"); - @list=grep(!/\#DEL\#$/,@list) if (scalar(@list) > $maxshow); - - my $prefix = "factoid author list by '$query' "; - &performStrictReply( &formListReply(1, $prefix, @list) ); -} - -1; diff --git a/blootbot/src/Modules/HTTPDtype.pl b/blootbot/src/Modules/HTTPDtype.pl deleted file mode 100644 index 5906077..0000000 --- a/blootbot/src/Modules/HTTPDtype.pl +++ /dev/null @@ -1,33 +0,0 @@ -# HTTPDtype.pl: retrieves http server headers -# Author: Joey Smith -# Licensing: Artistic License -# Version: v0.1 (20031110) -# -use strict; - -package HTTPDtype; - -sub HTTPDtype { - my($HOST) = @_; - my($line) = ''; - my($code, $mess, %h); - - # TODO: remove leading http:// and trailing :port and /foo if found - $HOST = 'joeysmith.com' unless length($HOST) > 0; - return unless &::loadPerlModule("Net::HTTP::NB"); - return unless &::loadPerlModule("IO::Select"); - - my $s = Net::HTTP::NB->new(Host => $HOST) || return; - $s->write_request(HEAD => "/"); - - my $sel = IO::Select->new($s); - $line = 'Header timeout' unless $sel->can_read(10); - ($code, $mess, %h) = $s->read_response_headers; - - $line = (length($h{Server}) > 0) ? $h{Server} : - "Couldn't fetch headers from $HOST"; - - &::performStrictReply($line||'Unknown Error Condition'); -} - -1; diff --git a/blootbot/src/Modules/Kernel.pl b/blootbot/src/Modules/Kernel.pl deleted file mode 100644 index 2b0ba90..0000000 --- a/blootbot/src/Modules/Kernel.pl +++ /dev/null @@ -1,93 +0,0 @@ -# -# Kernel.pl: Frontend to linux.kernel.org. -# Author: dms -# Version: v0.3 (19990919). -# Created: 19990729 -# - -package Kernel; - -sub kernelGetInfo { - return &::getURL("http://www.kernel.org/kdist/finger_banner"); -} - -sub Kernel { - my $retval = 'Linux kernel versions'; - my @now = &kernelGetInfo(); - if (!scalar @now) { - &::msg($::who, "failed."); - return; - } - - foreach $line (@now) { - $line =~ s/The latest //; - $line =~ s/version //; - $line =~ s/of //; - $line =~ s/the //; - $line =~ s/Linux //; - $line =~ s/kernel //; - $line =~ s/tree //; - $line =~ s/ for stable//; - $line =~ s/ to stable kernels//; - $line =~ s/ for 2.4//; - $line =~ s/ for 2.2//; - $line =~ s/ is: */: /; - $retval .= ', ' . $line; - } - &::performStrictReply($retval); -} - -sub kernelAnnounce { - my $file = "$::param{tempDir}/kernel.txt"; - my @now = &kernelGetInfo(); - my @old; - - if (!scalar @now) { - &::DEBUG('kA: failure to retrieve.'); - return; - } - - if (! -f $file) { - open(OUT, ">$file"); - foreach (@now) { - print OUT "$_\n"; - } - close OUT; - - return; - } else { - open(IN, $file); - while () { - chop; - push(@old,$_); - } - close IN; - } - - my @new; - for(my $i=0; $i$file"); - foreach (@now) { - print OUT "$_\n"; - } - close OUT; - - return @new; -} - -1; diff --git a/blootbot/src/Modules/Math.pl b/blootbot/src/Modules/Math.pl deleted file mode 100644 index 32350ff..0000000 --- a/blootbot/src/Modules/Math.pl +++ /dev/null @@ -1,140 +0,0 @@ -# -# infobot copyright (C) kevin lenzo 1997-98 -# - -use strict; - -use vars qw($message); - -my %digits = ( - 'first', '1', - 'second', '2', - 'third', '3', - 'fourth', '4', - 'fifth', '5', - 'sixth', '6', - 'seventh', '7', - 'eighth', '8', - 'ninth', '9', - 'tenth', '10', - 'one', '1', - 'two', '2', - 'three', '3', - 'four', '4', - 'five', '5', - 'six', '6', - 'seven', '7', - 'eight', '8', - 'nine', '9', - 'ten', '10' -); - -sub perlMath { - my($locMsg) = $message; - - if ($message =~ /^\s*$/) { - return; - } - - foreach (keys %digits) { - $locMsg =~ s/$_/$digits{$_}/g; - } - - while ($locMsg =~ /(exp ([\w\d]+))/) { - my($exp, $val) = ($1, exp $2); - $locMsg =~ s/$exp/+$val/g; - } - - while ($locMsg =~ /(hex2dec\s*([0-9A-Fa-f]+))/) { - my($exp, $val) = ($1, hex $2); - $locMsg =~ s/$exp/+$val/g; - } - - if ($locMsg =~ /^\s*(dec2hex\s*(\d+))\s*\?*/) { - my ($exp, $val) = ($1, sprintf("%x", "$2")); - $locMsg =~ s/$exp/+$val/g; - } - - my $e = exp(1); - $locMsg =~ s/\be\b/$e/; - - while ($locMsg =~ /(log\s*((\d+\.?\d*)|\d*\.?\d+))\s*/) { - my ($exp, $res) = ($1, $2); - my $val = ($res) ? log($res) : 'Infinity'; - $locMsg =~ s/$exp/+$val/g; - } - - while ($locMsg =~ /(bin2dec ([01]+))/) { - my $exp = $1; - my $val = join ('', unpack('B*',$2)) ; - $locMsg =~ s/$exp/+$val/g; - } - - while ($locMsg =~ /(dec2bin (\d+))/) { - my $exp = $1; - my $val = join('', unpack('B*', pack('N',$2))); - $val =~ s/^0+//; - $locMsg =~ s/$exp/+$val/g; - } - - for ($locMsg) { - s/\bpi\b/3.14159265/g; - s/ to the / ** /g; - s/\btimes\b/\*/g; - s/\bdiv(ided by)? /\/ /g; - s/\bover /\/ /g; - s/\bsquared/\*\*2 /g; - s/\bcubed/\*\*3 /g; - s/\bto\s+(\d+)(r?st|nd|rd|th)?( power)?/\*\*$1 /ig; - s/\bpercent of/*0.01*/ig; - s/\bpercent/*0.01/ig; - s/\% of\b/*0.01*/g; - s/\%/*0.01/g; - s/\bsquare root of (\d+)/$1 ** 0.5 /ig; - s/\bcubed? root of (\d+)/$1 **(1.0\/3.0) /ig; - s/ of / * /; - s/(bit(-| )?)?xor(\'?e?d( with))?/\^/g; - s/(bit(-| )?)?or(\'?e?d( with))?/\|/g; - s/bit(-| )?and(\'?e?d( with))?/\& /g; - s/(plus|and)/+/ig; - } - - # what the hell is this shit? - if (($locMsg =~ /^\s*[-\d*+\s()\/^\.\|\&\*\!]+\s*$/) - && ($locMsg !~ /^\s*\(?\d+\.?\d*\)?\s*$/) - && ($locMsg !~ /^\s*$/) - && ($locMsg !~ /^\s*[( )]+\s*$/) - && ($locMsg =~ /\d+/) - ) { - $locMsg =~ s/([0-9]+\.[0-9]+(\.[0-9]+)+)/"$1"/g; - $locMsg = eval($locMsg); - - if (defined $locMsg and $locMsg =~ /^[-+\de\.]+$/) { - $locMsg = sprintf("%1.12f", $locMsg); - $locMsg =~ s/\.?0+$//; - - if (length $locMsg > 30) { - $locMsg = "a number with quite a few digits..."; - } - } else { - if (defined $locMsg) { - &FIXME("math: locMsg => '$locMsg'..."); - } else { - &status("math: could not really compute."); - $locMsg = ''; - } - } - } else { - $locMsg = ''; - } - - if (defined $locMsg and $locMsg ne $message) { - # success. - return $locMsg; - } else { - # no match. - return ''; - } -} - -1; diff --git a/blootbot/src/Modules/News.pl b/blootbot/src/Modules/News.pl deleted file mode 100644 index 5e1200b..0000000 --- a/blootbot/src/Modules/News.pl +++ /dev/null @@ -1,1030 +0,0 @@ -# -# News.pl: Advanced news management -# Author: dms -# Version: v0.3 (20010412) -# Created: 20010326 -# Notes: Testing done by greycat, kudos! -# -### structure: -# news{ channel }{ string } { item } -# newsuser{ channel }{ user } = time() -### where item is: -# Time - when it was added (used for sorting) -# Author - Who by. -# Expire - Time to expire. -# Text - Actual text. -### - -package News; - -use strict; - -use vars qw($who $chan); - -sub Parse { - my($what) = @_; - $chan = undef; - $who = lc $::who; - - if (!keys %::news) { - if (!exists $::cache{newsFirst}) { - &::DEBUG("news: looks like we enabled news option just then; loading up news file just in case."); - $::cache{newsFirst} = 1; - } - - &readNews(); - } - - if ($::msgType ne 'private') { - $chan = $::chan; - } - - if (defined $what and $what =~ s/^($::mask{chan})\s*//) { - # TODO: check if the channel exists aswell. - $chan = lc $1; - - if (!&::IsNickInChan($who, $chan)) { - &::notice($who, "sorry but you're not on $chan."); - return; - } - } - - if (!defined $chan) { - my @chans = &::getNickInChans($who); - - if (scalar @chans > 1) { - &::notice($who, "error: I dunno which channel you are referring to since you're on more than one. Try 'news #chan ...' instead"); - return; - } - - if (scalar @chans == 0) { - &::notice($who, "error: I couldn't find you on any chan. This must be a bug!"); - return; - } - - $chan = $chans[0]; - &::VERB("Guessed $who being on chan $chan",2); - $::chan = $chan; # hack for IsChanConf(). - } - - if (!defined $what or $what =~ /^\s*$/) { - &list(); - return; - } - - if ($what =~ /^add(\s+(.*))?$/i) { - &add($2); - - } elsif ($what =~ /^del(\s+(.*))?$/i) { - &del($2); - - } elsif ($what =~ /^mod(\s+(.*))?$/i) { - &mod($2); - - } elsif ($what =~ /^set(\s+(.*))?$/i) { - &set($2); - - } elsif ($what =~ /^(\d+)$/i) { - &::VERB("News: read shortcut called.",2); - &read($1); - - } elsif ($what =~ /^read(\s+(.*))?$/i) { - &read($2); - - } elsif ($what =~ /^(latest|new)(\s+(.*))?$/i) { - &latest($3 || $chan, 1); -# $::cmdstats{'News latest'}++; - - } elsif ($what =~ /^stats?$/i) { - &stats(); - - } elsif ($what =~ /^list$/i) { - &list(); - - } elsif ($what =~ /^(expire|text|desc)(\s+(.*))?$/i) { - # shortcut/link. - # nice hack. - my $cmd = $1; - my($arg1,$arg2) = split(/\s+/, $3, 2); - &set("$arg1 $cmd $arg2"); - - } elsif ($what =~ /^help(\s+(.*))?$/i) { - &::help("news $2"); - - } elsif ($what =~ /^newsflush$/i) { - &::msg($who, "newsflush called... check out the logs!"); - &::newsFlush(); - - } elsif ($what =~ /^(un)?notify$/i) { - my $state = ($1) ? 0 : 1; - - # TODO: don't notify even if 'News' is called. - if (&::IsChanConf('newsNotifyAll') <= 0) { - &::DEBUG("news: chan => $chan, ::chan => $::chan."); - &::notice($who, "not available for this channel or disabled altogether."); - return; - } - - my $t = $::newsuser{$chan}{$who}; - if ($state) { # state = 1 - if (defined $t and ($t == 0 or $t == -1)) { - &::notice($who, "enabled notify."); - delete $::newsuser{$chan}{$who}; - return; - } - &::notice($who, "already enabled."); - - } else { # state = 0 - my $x = $::newsuser{$chan}{$who}; - if (defined $x and ($x == 0 or $x == -1)) { - &::notice($who, 'notify already disabled'); - return; - } - $::newsuser{$chan}{$who} = -1; - &::notice($who, "notify is now disabled."); - } - - } else { - &::notice($who, "unknown command: $what"); - } -} - -sub readNews { - my $file = "$::bot_base_dir/blootbot-news.txt"; - if (! -f $file or -z $file) { - return; - } - - if (fileno NEWS) { - &::DEBUG("readNews: fileno exists, should never happen."); - return; - } - - my($item,$chan); - my($ci,$cu) = (0,0); - - open(NEWS, $file); - while () { - chop; - - # TODO: allow commands. - - if (/^[\s\t]+(\S+):[\s\t]+(.*)$/) { - if (!defined $item) { - &::DEBUG("news: !defined item, never happen!"); - next; - } - - $::news{$chan}{$item}{$1} = $2; - next; - } - - # U
Jeff Waugh - find it at +freshmeat.net! +Modified by Tim Riker to work with +infobot logs, split per channel, etc. + +}; + return $return; +} + +my $lastdate = ''; + +sub add_footers { + my $filename; + + return if not $lastdate; + + my @files=`ls $lastdate.html */$lastdate.html`; + foreach $filename (@files) { + chomp $filename; + if (!open(OUTPUT, ">>$filename")) { + print "Cannot open $filename for writing!\n\n"; + return; + } + print OUTPUT footer(); + close OUTPUT; + } +} + +sub output_line { + my ($date, $time, $channel, $lineout) = @_; + + add_footers() if $lastdate ne $date; + + $lastdate = $date; + my $filename = ""; + $filename .= "$channel/" if $channel; + $filename .= "$date.html"; + + mkdir($channel,oct('755')) if ($channel && ! -d $channel); + if (!open(OUTPUT, ">>$filename")) { + #print "Cannot open $filename for writing!\n\n"; + return; + } + # Begin output # + print OUTPUT header($channel, $date) if -z $filename; + + print OUTPUT $lineout; + + close OUTPUT; +} + +sub output_timenicktext { + my ($date, $time, $channel, $nick, $text, $htmlcolour) = @_; + my $lineout = ''; + + if ($STYLE eq "table") { + $lineout .= ""; + $lineout .= "$time" if $time; + $lineout .= "$nick"; + $lineout .= "$text<\/font>\n"; + } + elsif ($STYLE eq "simpletable") { + $lineout .= ""; + $lineout .= "$time" if $time; + $lineout .= "$nick"; + $lineout .= "$text\n"; + } + elsif ($STYLE eq "simplett") { + $lineout .= "$time " if $time; + $lineout .= "<\;$nick>\; $text
\n"; + } + else { + $lineout .= "$time " if $time; + $lineout .= "<\;$nick>\; $text<\/font>
\n"; + } + output_line($date, $time, $channel, $lineout); +} + +sub output_timeservermsg { + my ($date, $time, $channel, $line) = @_; + my $lineout = ''; + + if ($STYLE =~ /table/) { + $lineout .= ""; + $lineout .= "$time" if $time; + $lineout .= "$line\n"; + } + else { + $lineout .= "$time " if $time; + $lineout .= "$line
\n"; + } + output_line($date, $time, $channel, $lineout); +} + +sub html_rgb +{ + my ($i,$ncolours) = @_; + $ncolours = 1 if $ncolours == 0; + + my $rgbmax = 125; # tune these two for the outmost ranges of colour depth + my $rgbmin = 240; + + my $a = 0.95; # tune these for the starting and ending concentrations of R,G,B + my $c = 0.5; + + my $rgb = [ [$a,$c,$c], [$c,$a,$c], [$c,$c,$a], [$a,$a,$c], [$a,$c,$a], [$c,$a,$a] ]; + my $n = $i % @$rgb; + my $m = $rgbmin + ($rgbmax - $rgbmin) * ($ncolours - $i) / $ncolours; + + my $r = $rgb->[$n][0] * $m; + my $g = $rgb->[$n][1] * $m; + my $b = $rgb->[$n][2] * $m; + sprintf("#%02x%02x%02x",$r,$g,$b); +} + +#################################################################################### +# Main + +sub main { + my ($date) = @_; + my $files; + + my $line; + my $time; + my $lastdate = ""; + my $nick; + my $channel; + my $text; + + my $htmlcolour; + my $nickcount = 0; + my $NICKMAX = 30; + + my %colour_nick = %prefs_colour_nick; + + while ($line = ) { + + chomp $line; + + if (!$line eq "") { + # parse out the time + if ($line =~ s/^([0-9:\.]*) (.*)$/$2/) { + $time = $1; + } else { + $time = ''; + } + $channel = ''; + + # Replace ampersands, pointies, control characters # + $line =~ s/&/&\;/g; + $line =~ s//>\;/g; + $line =~ s/\e\[[0-1]*m//g; + $line =~ s/[\x00-\x1f]+//g; + + # Replace possible URLs with links # + $line =~ s/((http|https|ftp|gopher|news):\/\/\S*)/$1<\/a>/g; + + # Colourise the comments + if ($line =~ /^<\;[^\/]*?\/\#.*?>\; .*$/) { + # Split $nick, $channel and $line + $nick = $line; + $nick =~ s/^<\;([^\/]*?)\/\#.*?>\; .*$/$1/; + $channel = $line; + $channel =~ s/^<\;[^\/]*?\/(\#.*?)>\; .*$/$1/; + + # $nick =~ tr/[A-Z]/[a-z]/; + # <======= move this into another function when getting nick colour + + $text = $line; + $text =~ s/^<\;.*?>\; (.*)$/$1/; + $text =~ s/^ .*/<\;PROTECTED>\;/g; + $text =~ s/ / \; \;/g; + + $htmlcolour = $colour_nick{$nick}; + if (!defined($htmlcolour)) { + # new nick + $nickcount++; + + # if we've exceeded our estimate of the number of nicks, double it + $NICKMAX *= 2 if $nickcount >= $NICKMAX; + + $htmlcolour = $colour_nick{$nick} = html_rgb($nickcount, $NICKMAX); + } + output_timenicktext($date, $time, $channel, $nick, $text, $htmlcolour); + } elsif ($line =~ /^>\;>\;>\; /) { + $line =~ s/^>\;>\;>\; /\*\*\* /; + + # Process changed nick results, and remember colours accordingly # + if ($line =~ /\*\*\* (.*?) materializes into (.*)/) { + my $nick_old = $1; + my $nick_new = $2; + + #$nick_old = $line; + #$nick_old =~ s/\*\*\* (.*?) materializes into .*/$1/; + #$nick_new = $line; + #$nick_new =~ s/\*\*\* (.*?) materializes into (.*)/$2/; + + $colour_nick{$nick_new} = $colour_nick{$nick_old}; + $colour_nick{$nick_old} = undef; + + $line =~ s/(\*\*\* .*)/$1<\/font>/ + } elsif ($line =~ /\*\*\* (join|mode|topic)\/(.*?) .*/) { + $channel = lc $2; + $line =~ s/(\*\*\* .*)/$1<\/font>/; + } elsif ($line =~ /\*\*\* (part|kick|banned)\/(.*?) .*/) { + $channel = lc $2; + $line =~ s/(\*\*\* .*)/$1<\/font>/; + } elsif ($line =~ /\*\*\* .* has signed off IRC .*/) { + # Colourise joined/left/server messages # + $line =~ s/(\*\*\* .*)/$1<\/font>/; + } elsif ($line =~ /\*\*\* /) { + $line =~ s/(\*\*\* .*)$/$1<\/font>/; + } elsif ($line =~ /^\* .*$/) { + # Colourise the /me's # + $line =~ s/^(\*.*)$/$1<\/font>/; + } + + output_timeservermsg($date, $time, $channel, $line); + } + } + } + + add_footers(); + + return 0; +} + +if (!scalar @ARGV) { + print "Usage: irclog2html.pl < logfile\n"; + print "Example: bzcat log/infobot.log-20021104.bz2 | irclog2html.pl 20021104\n"; + exit 0; +} +my $date = shift; +exit &main($date); +# vim: ts=2 diff --git a/scripts/makepasswd b/scripts/makepasswd new file mode 100755 index 0000000..b76617c --- /dev/null +++ b/scripts/makepasswd @@ -0,0 +1,20 @@ +#!/usr/bin/perl + +$| = 1; + +print "plaintext> "; +while (<>) { + chomp; + $result = &mkpasswd($_); + print "\t$result\n"; + print "plaintext> "; +} + +sub mkpasswd { + my $what = $_[0]; + my $salt = chr(65+rand(27)).chr(65+rand(27)); + $salt =~ s/\W/x/g; + + return crypt($what, $salt); +} + diff --git a/scripts/mysql2txt.pl b/scripts/mysql2txt.pl new file mode 100755 index 0000000..2973610 --- /dev/null +++ b/scripts/mysql2txt.pl @@ -0,0 +1,47 @@ +#!/usr/bin/perl +# mysql -> txt. +# written by the xk. +### + +require "src/core.pl"; +require "src/logger.pl"; +require "src/modules.pl"; +require "src/Misc.pl"; +require "src/Files.pl"; +$bot_src_dir = "./src/"; + +my $dbname = shift; +if (!defined $dbname) { + print "Usage: $0 \n"; + print "Example: $0 factoids\n"; + exit 0; +} + +# open the db. +&loadConfig("files/infobot.config"); +&loadDBModules(); + +&openDB($param{'DBName'}, $param{'SQLUser'}, $param{'SQLPass'}); + +# retrieve a list of db's from the server. +my %db; +foreach ($dbh->func('_ListTables')) { + $db{$_} = 1; +} + +# factoid db. +if (!exists $db{$dbname}) { + print "error: $dbname does not exist as a table.\n"; + exit 1; +} + +my $query = "SELECT factoid_key,factoid_value from $param{'DBName'}.$dbname"; +my $sth = $dbh->prepare($query); +$sth->execute; +while (my @row = $sth->fetchrow_array) { + print "$row[0] => $row[1]\n"; +} +$sth->finish; + +print "Done.\n"; +&closeDB(); diff --git a/scripts/oreilly_dumpvar.pl b/scripts/oreilly_dumpvar.pl new file mode 100644 index 0000000..3efe8b6 --- /dev/null +++ b/scripts/oreilly_dumpvar.pl @@ -0,0 +1,27 @@ +package DUMPVAR; +sub dumpvar { + ($packageName) = @_; + $rPackage = \%{"${packageName}::"}; # Get a reference to the appropriate symbol table hash. + $, = " " ; + while (($varName, $globValue) = each %$rPackage) { + print "$varName ============================= \n"; + *var = $globValue; + if (defined ($var)) { + print "\t \$$varName $var \n"; + } + if (defined (@var)) { + print "\t \@$varName @var \n"; + } + if (defined (%var)) { + print "\t \%$varName ",%var," \n"; + } + } +} + + +package Test; +$x = 10; +@y = (1,3,4); +%z = (1,2,3,4, 5, 6, \@y); +$z = 300; +DUMPVAR::dumpvar("Test"); diff --git a/scripts/oreilly_prettyp.pl b/scripts/oreilly_prettyp.pl new file mode 100644 index 0000000..db58d78 --- /dev/null +++ b/scripts/oreilly_prettyp.pl @@ -0,0 +1,87 @@ +@sample = (11.233,{3 => 4, "hello" => [6,7]}); +pretty_print(@sample); + +$level = -1; # Level of indentation + +sub pretty_print { + my $var; + foreach $var (@_) { + if (ref ($var)) { + print_ref($var); + } else { + print_scalar($var); + } + } +} + +sub print_scalar { + ++$level; + print_indented ($_[0]); + --$level; +} + +sub print_ref { + my $r = $_[0]; + if (exists ($already_seen{$r})) { + print_indented ("$r (Seen earlier)"); + return; + } else { + $already_seen{$r}=1; + } + my $ref_type = ref($r); + if ($ref_type eq "ARRAY") { + print_array($r); + } elsif ($ref_type eq "SCALAR") { + print "Ref -> $r"; + print_scalar($$r); + } elsif ($ref_type eq "HASH") { + print_hash($r); + } elsif ($ref_type eq "REF") { + ++$level; + print_indented("Ref -> ($r)"); + print_ref($$r); + --$level; + } else { + print_indented ("$ref_type (not supported)"); + } +} + +sub print_array { + my ($r_array) = @_; + ++$level; + print_indented ("[ # $r_array"); + foreach $var (@$r_array) { + if (ref ($var)) { + print_ref($var); + } else { + print_scalar($var); + } + } + print_indented ("]"); + --$level; +} + +sub print_hash { + my($r_hash) = @_; + my($key, $val); + ++$level; + print_indented ("{ # $r_hash"); + while (($key, $val) = each %$r_hash) { + $val = ($val ? $val : '""'); + ++$level; + if (ref ($val)) { + print_indented ("$key => "); + print_ref($val); + } else { + print_indented ("$key => $val"); + } + --$level; + } + print_indented ("}"); + --$level; +} + +sub print_indented { + $spaces = ": " x $level; + print "${spaces}$_[0]\n"; +} diff --git a/scripts/output_stats.sh b/scripts/output_stats.sh new file mode 100644 index 0000000..409b55f --- /dev/null +++ b/scripts/output_stats.sh @@ -0,0 +1,7 @@ +#!/bin/sh +echo -n "DEBUG: "; grep DEBUG `find infobot src -type f`| wc -l +echo -n "WARN: "; grep WARN `find infobot src -type f` | wc -l +echo -n "FIXME: "; grep FIXME `find infobot src -type f` | wc -l +echo -n "status: "; grep status `find infobot src -type f` | wc -l +echo -n "ERROR: "; grep ERROR `find infobot src -type f` | wc -l +echo -n "TODO: "; grep TODO `find infobot src -type f` | wc -l diff --git a/scripts/parse_warn.pl b/scripts/parse_warn.pl new file mode 100755 index 0000000..53a224c --- /dev/null +++ b/scripts/parse_warn.pl @@ -0,0 +1,91 @@ +#!/usr/bin/perl -w + +# leading and trailing context lines. +my $contextspread = 2; + +use strict; + +$| = 1; + +if (!scalar @ARGV) { + print "Usage: parse_warn.pl \n"; + print "Example: parse_warn.pl log/*\n"; + exit 0; +} + +my %done; +my $file; + +foreach $file (@ARGV) { + if (! -f $file) { + print "warning: $file does not exist.\n"; + next; + } + my $str = ' at .* line '; + + print "Opening $file... "; + if ($file =~ /bz2$/) { # bz2 + open(FILE, "bzcat $file | egrep '$str' |"); + } elsif ($file =~ /gz$/) { # gz + open(FILE, "zegrep '$str' $file |"); + } else { # raw + open(FILE, "egrep '$str' $file |"); + } + + print "Parsing... "; + while () { + if (/ at (\S+) line (\d+)/) { + my ($file,$lineno) = ($1,$2+1); + $done{$file}{$lineno}++; + } + } + close FILE; + + print "Done.\n"; +} + +foreach $file (keys %done) { + my $count = scalar(keys %{$done{$file}}); + print "warn $file: $count unique warnings.\n"; + + if (! -f $file) { + print "=> error: does not exist.\n\n"; + next; + } + + if (open(IN,$file)) { + my @lines = ; + close IN; + + my $total = scalar @lines; + my $spread = 0; + my $done = 0; + for(my $i=0; $i<=$total; $i++) { + next unless (exists $done{$file}{$i+$contextspread} or $spread); + + if (exists $done{$file}{$i+$contextspread}) { + print "@@ $i @@\n" unless ($spread); + # max lines between offending lines should be 2*context-1. + # coincidence that it is! + $spread = 2*$contextspread; + } else { + $spread--; + } + + if (exists $done{$file}{$i}) { + print "*** "; + } else { + print "--- "; + } + + if ($i >= $total) { + print "EOF\n"; + } else { + print $lines[$i]; + } + } + print "\n"; + } else { + print "=> error: could not open file.\n"; + } +} diff --git a/scripts/showvars.pl b/scripts/showvars.pl new file mode 100644 index 0000000..22c55ac --- /dev/null +++ b/scripts/showvars.pl @@ -0,0 +1,110 @@ +@test = ("test"); + +sub dumpvar { + ($packageName) = @_; + $rPackage = \%{"${packageName}::"}; # Get a reference to the appropriate symbol table hash. + $, = " " ; + while (($varName, $globValue) = each %$rPackage) { + last if ($varName eq "main::"); + print "$varName ============================= \n"; + *var = $globValue; + if (defined ($var)) { + print "\t \$$varName = '$var' \n"; + } + if (defined (@var)) { + pretty_print(@var); +### print "\t \@$varName @var \n"; + } + if (defined (%var)) { + pretty_print(%var); +### print "\t \%$varName ",%var," \n"; + } + } +} + +dumpvar("main"); + +$level = -1; # Level of indentation + +sub pretty_print { + my $var; + foreach $var (@_) { + if (ref ($var)) { + print_ref($var); + } else { + print_scalar($var); + } + } +} + +sub print_scalar { + ++$level; + print_indented ($_[0]); + --$level; +} + +sub print_ref { + my $r = $_[0]; + if (exists ($already_seen{$r})) { + print_indented ("$r (Seen earlier)"); + return; + } else { + $already_seen{$r}=1; + } + my $ref_type = ref($r); + if ($ref_type eq "ARRAY") { + print_array($r); + } elsif ($ref_type eq "SCALAR") { + print "Ref -> $r"; + print_scalar($$r); + } elsif ($ref_type eq "HASH") { + print_hash($r); + } elsif ($ref_type eq "REF") { + ++$level; + print_indented("Ref -> ($r)"); + print_ref($$r); + --$level; + } else { + print_indented ("$ref_type (not supported)"); + } +} + +sub print_array { + my ($r_array) = @_; + ++$level; + print_indented ("[ # $r_array"); + foreach $var (@$r_array) { + if (ref ($var)) { + print_ref($var); + } else { + print_scalar($var); + } + } + print_indented ("]"); + --$level; +} + +sub print_hash { + my($r_hash) = @_; + my($key, $val); + ++$level; + print_indented ("{ # $r_hash"); + while (($key, $val) = each %$r_hash) { + $val = ($val ? $val : '""'); + ++$level; + if (ref ($val)) { + print_indented ("$key => "); + print_ref($val); + } else { + print_indented ("$key => $val"); + } + --$level; + } + print_indented ("}"); + --$level; +} + +sub print_indented { + $spaces = ": " x $level; + print "${spaces}$_[0]\n"; +} diff --git a/scripts/symname.pl b/scripts/symname.pl new file mode 100755 index 0000000..dfa71c7 --- /dev/null +++ b/scripts/symname.pl @@ -0,0 +1,104 @@ +#!/usr/bin/perl -w + +# hrm... +#use strict; + +my @test; +my @test1; +my %test; + +$test{'hash0r'} = 2; +$test{'hegdfgsd'} = 'GSDFSDfsd'; + +push(@test1,"Aeh."); +push(@test1,"Beh."); +push(@test1,"Ceh."); +push(@test1,"Deh."); + +push(@test,"heh."); +push(@test,\%test); +#push(@test,\%ENV); +push(@test,\@test1); + +print "=============start=================\n"; +#&DumpArray(0, '@test', \@test); +&DumpPackage(0, 'main::', \%main::); + +# SCALAR ARRAY HASH CODE REF GLOB LVALUE +sub DumpArray { + my ($pad, $symname, $arrayref) = @_; + my $padding = " " x $pad; + my $scalar = 0; + my $size = 0; + + print "$padding$symname\n"; + foreach (@{$arrayref}) { + my $ref = ref $_; + if ($ref eq 'ARRAY') { + $size += &DumpArray($pad+1, "@" . $_, $_); + } elsif ($ref eq 'HASH') { + $size += &DumpHash($pad+1, "%" . $_, $_); + } else { + print "$padding $_ $ref\n"; + $scalar++; + $size += length($_); + } + } + print $padding."scalars $scalar, size $size\n"; + return $size; +} + +sub DumpHash{ + my ($pad, $symname, $hashref) = @_; + my $padding = " " x $pad; + my $scalar = 0; + my $size = 0; + + my %sym = %{$hashref}; + my @list = sort keys %sym; + print "$padding$symname\n"; + + foreach (@list) { + my $ref = ref %{$symname}; #FIXME + $size += length($_); + if ($ref eq 'ARRAY') { + $size += &DumpArray($pad+1, "@" . $_, $_); + } elsif ($ref eq 'HASH') { + $size += &DumpHash($pad+1, "%" . $_, $_); + } else { + print "$padding $_=$sym{$_} $ref\n"; + $scalar++; + $size += length($sym{$_}); + } + } + print $padding."scalars $scalar, size $size\n"; + return $size; +} + +sub DumpPackage { + my ($pad, $packname, $package) = @_; + my $padding = " " x $pad; + my $scalar = 0; + my $size = 0; + + print $padding . "\%$packname\n"; + my $symname; + foreach $symname (sort keys %$package) { + local *sym = $$package{$symname}; + if (defined $sym) { + print "$padding \$$symname='$sym'\n"; + $scalar++; + $size += length($sym); + } elsif (defined @sym) { + $size += &DumpArray($pad+1, $symname, \@sym); + } elsif (defined %sym) { + $size += &DumpHash($pad+1, $symname, \%sym); + } elsif (($symname =~ /::/) and ($symname ne 'main::')) { + $size += &DumpPackage($pad+1, \%sym, $symname); + } else { + print("ERROR $symname" . ref $symname . "\n"); + } + } + print $padding."scalars $scalar, size $size\n"; + return $size; +} diff --git a/scripts/txt2mysql.pl b/scripts/txt2mysql.pl new file mode 100755 index 0000000..88ace25 --- /dev/null +++ b/scripts/txt2mysql.pl @@ -0,0 +1,57 @@ +#!/usr/bin/perl +# by the xk. +# + +require "src/core.pl"; +require "src/logger.pl"; +require "src/modules.pl"; +require "src/Files.pl"; +require "src/Misc.pl"; +require "src/Factoids/DBCommon.pl"; + +if (!scalar @ARGV) { + print "Usage: txt2mysql.pl \n"; + exit 0; +} + +# open the txtfile. +my $txtfile = shift; +open(IN,$txtfile) or die "error: cannot open txtfile '$txtfile'.\n"; + +# read the bot config file. +&loadConfig("files/infobot.config"); +&loadDBModules(); +&openDB($param{'DBName'}, $param{'SQLUser'}, $param{'SQLPass'}); + +### now pipe all the data to the mysql server... +my $i = 1; +print "converting factoid db to mysql...\n"; +while () { + chop; + next if !length; + if (/^(.*)\s+=>\s+(.*)$/) { + # verify if it already exists? + my ($key,$val) = ($1,$2); + if ($key =~ /^\s*$/ or $val =~ /^\s*$/) { + print "warning: broken => '$_'.\n"; + next; + } + + if (&IsParam("freshmeat") and &dbGet("freshmeat", "name", $key, "name")) { + if (&getFactoid($key)) { + &delFactoid($key); + } + } else { + &setFactInfo(lc $key, "factoid_value", $val); + $i++; + } + + print "$i... " if ($i % 100 == 0); + } else { + print "warning: invalid => '$_'.\n"; + } +} +close IN; + +print "Done.\n"; +&closeDB(); diff --git a/scripts/vartree.pl b/scripts/vartree.pl new file mode 100644 index 0000000..d96fcc1 --- /dev/null +++ b/scripts/vartree.pl @@ -0,0 +1,80 @@ +#!/usr/bin/perl -w +# hrm... + +# use strict; + +local @test; +local %test; + +$test{'hash0r'} = 2; +$test{'hegdfgsd'} = 'GSDFSDfsd'; + +push(@test,"heh."); +push(@test,\%test); + +&vartree(\%main::, 'main::'); + + +sub tree { + my ($pad, $ref, $symname) = @_; + my $padded = " " x $pad; + my @list; + my $scalar = 0; + my $size = 0; + + @list = keys %{$symname} if ($ref eq 'HASH'); + @list = @{$symname} if ($ref eq 'ARRAY'); + + foreach (@list) { + my $ref = ref $_; + + if ($ref eq 'HASH' or $ref eq 'ARRAY') { + print $padded."recursing $ref($_).\n"; + &tree($pad+2, $ref, $_); + } elsif ($ref eq '') { + $scalar++; + $size += length($_); + } + } + print $padded."scalars $scalar, size $size\n"; +} + +sub vartree { + my ($package, $packname) = @_; + my $symname; + + # scalar. + foreach $symname (sort keys %$package) { + local *sym = $$package{$symname}; + next unless (defined $sym); + print "scalar => $symname = '$sym'\n"; + } + + # array. + foreach $symname (sort keys %$package) { + local *sym = $$package{$symname}; + next unless (defined @sym); + print "\@$symname\n"; + &tree(2, "ARRAY", $symname); + } + + # hash. + foreach $symname (sort keys %$package) { + local *sym = $$package{$symname}; + next unless (defined %sym); + print "\%$symname\n"; + &tree(2, "HASH", $symname); + } + + foreach $symname (sort keys %$package) { + local *sym = $$package{$symname}; + next unless (defined %sym); + next unless ($symname =~ /::/); + next if ($symname eq 'main::'); + + print "recurse: $symname.\n"; + &vartree(\%sym, $symname); + } + + print "end.\n"; +} diff --git a/scripts/webbackup.pl b/scripts/webbackup.pl new file mode 100755 index 0000000..ce6412e --- /dev/null +++ b/scripts/webbackup.pl @@ -0,0 +1,95 @@ +#!/usr/bin/perl -w + +use strict; +use LWP; +use POSIX qw(strftime); + +my $backup_interval = 1; # every: 1,7,14,30. +my $backup_count = 7; +my $backup_url = "http://core.junker.org/~apt/tables.tar.bz2"; +my $backup_file = "tables-##DATE.tar.bz2"; +my $backup_destdir = "/home/xk/public_html/"; +my $backup_indexfile = "tables-index.txt"; + +my %index; + +# Usage: &getURL($url); +sub getURL { + my ($url) = @_; + my ($ua,$res,$req); + + $ua = new LWP::UserAgent; +### $ua->proxy('http', $proxy); + + $req = new HTTP::Request('GET',$url); + $res = $ua->request($req); + + # return NULL upon error. + if ($res->is_success) { + return $res->content; + } else { + print "error: failure.\n"; + exit 1; + } +} + +#... +if ( -f "$backup_destdir/$backup_indexfile") { + if (open(INDEX, "$backup_destdir/$backup_indexfile")) { + while () { + chop; + + # days since 1970, file. + if (/^(\d+) (\S+)$/) { + $index{$1} = $2; + } + } + close INDEX; + } else { + print "WARNING: can't open $backup_indexfile.\n"; + } +} +my $now_days = (localtime)[7] + (((localtime)[5] - 70) * 365); +my $now_date = strftime("%Y%m%d", localtime); + +if (scalar keys %index) { + my $last_days = (sort {$b <=> $a} keys %index)[0]; + + if ($now_days - $last_days < $backup_interval) { + print "error: shouldn't run today.\n"; + goto cycle; + } +} + +$backup_file =~ s/##DATE/$now_date/; +print "backup_file => '$backup_file'.\n"; +if ( -f $backup_file) { + print "error: $backup_file already exists.\n"; + exit 1; +} + +my $file = &getURL($backup_url); +open(OUT,">$backup_destdir/$backup_file"); +print OUT $file; +close OUT; + +$index{$now_days} = $backup_file; +cycle:; +my @index = sort {$b <=> $a} keys %index; + +open(OUT,">$backup_destdir/$backup_indexfile"); +for(my $i=0; $i '$day'.\n"; + + if ($backup_count - 1 >= $i) { + print "DEBUG: $day $index{$day}\n"; + print OUT "$day $index{$day}\n"; + } else { + print "Deleting $index{$day}\n"; + unlink $backup_destdir."/".$index{$day}; + } +} +close OUT; + +print "Done.\n"; diff --git a/setup/README b/setup/README new file mode 100644 index 0000000..06bd2f1 --- /dev/null +++ b/setup/README @@ -0,0 +1,22 @@ +Welcome, + +This directory has changed slightly. The new format allows for +each type of database to have its own schema. The following +directories are included: + + mysql/ -- Schema for the popular MySQL + sqlite/ -- Schema for v2 or v3 of SQLite + sqlite2/ -- Schema for specifically v2 of SQLite + pgsql/ -- Schema for PostgreSQL + +Also, the included setup.pl has been modified to work with +all of the above types of databases. (FIXME: actually, only +MySQL until I actually change it) + +To automate the setup of your database and user, type: + + cd ~/infobotdir + ./setup/setup.pl + +(NOTE: The setup will ask for an account capable of administrating +the database server!) diff --git a/setup/mysql/botmail.sql b/setup/mysql/botmail.sql new file mode 100644 index 0000000..2789338 --- /dev/null +++ b/setup/mysql/botmail.sql @@ -0,0 +1,8 @@ +CREATE TABLE botmail ( + srcwho VARCHAR(20) NOT NULL, + dstwho VARCHAR(20) NOT NULL, + srcuh VARCHAR(80) NOT NULL, + time INT UNSIGNED DEFAULT 'UNIX_TIMESTAMP()', + msg TEXT NOT NULL, + PRIMARY KEY (srcwho,dstwho) +); diff --git a/setup/mysql/connections.sql b/setup/mysql/connections.sql new file mode 100644 index 0000000..d1256c1 --- /dev/null +++ b/setup/mysql/connections.sql @@ -0,0 +1,9 @@ +CREATE TABLE connections ( + server VARCHAR(30) NOT NULL, + port INT NOT NULL DEFAULT '6667', + nick VARCHAR(20) NOT NULL, + nickservpass VARCHAR(8) NOT NULL, + ircname VARCHAR (20) NOT NULL DEFAULT 'infobot experimental bot', + timeadded INT UNSIGNED DEFAULT 'UNIX_TIMESTAMP()', + PRIMARY KEY (server,port,nick) +); diff --git a/setup/mysql/factoids.sql b/setup/mysql/factoids.sql new file mode 100644 index 0000000..d5189d0 --- /dev/null +++ b/setup/mysql/factoids.sql @@ -0,0 +1,14 @@ +CREATE TABLE factoids ( + factoid_key VARCHAR(64) NOT NULL, + requested_by VARCHAR(64) NOT NULL DEFAULT 'nobody', + requested_time INT NOT NULL DEFAULT '0', + requested_count SMALLINT UNSIGNED NOT NULL DEFAULT '0', + created_by VARCHAR(64), + created_time INT NOT NULL DEFAULT '0', + modified_by VARCHAR(192), + modified_time INT NOT NULL DEFAULT '0', + locked_by VARCHAR(64), + locked_time INT NOT NULL DEFAULT '0', + factoid_value TEXT NOT NULL, + PRIMARY KEY (factoid_key) +); diff --git a/setup/mysql/freshmeat.sql b/setup/mysql/freshmeat.sql new file mode 100644 index 0000000..4b4f42b --- /dev/null +++ b/setup/mysql/freshmeat.sql @@ -0,0 +1,8 @@ +CREATE TABLE freshmeat ( + projectname_short VARCHAR(64) NOT NULL, + latest_version VARCHAR(32) DEFAULT 'none' NOT NULL, + license VARCHAR(32), + url_homepage VARCHAR(128), + desc_short VARCHAR(96) NOT NULL, + PRIMARY KEY (projectname_short,latest_version) +); diff --git a/setup/mysql/news.sql b/setup/mysql/news.sql new file mode 100644 index 0000000..ebfb0e2 --- /dev/null +++ b/setup/mysql/news.sql @@ -0,0 +1,7 @@ +CREATE TABLE news ( + channel VARCHAR(16) NOT NULL, + id INT UNSIGNED DEFAULT '0', + key VARCHAR(16) NOT NULL, + value TEXT NOT NULL, # limit to ~450 or so. + PRIMARY KEY (channel,id,key) +); diff --git a/setup/mysql/onjoin.sql b/setup/mysql/onjoin.sql new file mode 100644 index 0000000..994cc54 --- /dev/null +++ b/setup/mysql/onjoin.sql @@ -0,0 +1,14 @@ +CREATE TABLE onjoin ( + nick VARCHAR(20) NOT NULL, + channel VARCHAR(16) NOT NULL, + message VARCHAR(255) NOT NULL, + modified_by VARCHAR(20) NOT NULL DEFAULT 'nobody', + modified_time INT NOT NULL DEFAULT '0', + PRIMARY KEY (nick, channel) +); + +-- v.2 -> v.3 +-- ALTER TABLE onjoin ADD COLUMN modified_by VARCHAR(20) NOT NULL DEFAULT 'nobody'; +-- ALTER TABLE onjoin ADD COLUMN modified_time INT NOT NULL DEFAULT '0'; +-- ** the following doesn't work for sqlite ** +-- ALTER TABLE onjoin ADD PRIMARY KEY (nick, channel); diff --git a/setup/mysql/rootwarn.sql b/setup/mysql/rootwarn.sql new file mode 100644 index 0000000..afcee2c --- /dev/null +++ b/setup/mysql/rootwarn.sql @@ -0,0 +1,8 @@ +CREATE TABLE rootwarn ( + nick VARCHAR(20) NOT NULL, + attempt SMALLINT UNSIGNED, + time INT NOT NULL, + host VARCHAR(80) NOT NULL, + channel VARCHAR(20) NOT NULL, + PRIMARY KEY (nick) +); diff --git a/setup/mysql/seen.sql b/setup/mysql/seen.sql new file mode 100644 index 0000000..d920f79 --- /dev/null +++ b/setup/mysql/seen.sql @@ -0,0 +1,8 @@ +CREATE TABLE seen ( + nick VARCHAR(20) NOT NULL, + time INT NOT NULL, + channel VARCHAR(20) NOT NULL, + host VARCHAR(80) NOT NULL, + message TINYTEXT NOT NULL, + PRIMARY KEY (nick,channel) +); diff --git a/setup/mysql/stats.sql b/setup/mysql/stats.sql new file mode 100644 index 0000000..97f773c --- /dev/null +++ b/setup/mysql/stats.sql @@ -0,0 +1,8 @@ +CREATE TABLE stats ( + nick VARCHAR(20) NOT NULL, + type VARCHAR(8) NOT NULL, + channel VARCHAR(16) NOT NULL DEFAULT "PRIVATE", + time INT UNSIGNED DEFAULT 'UNIX_TIMESTAMP()', + counter SMALLINT UNSIGNED DEFAULT '0', + PRIMARY KEY (nick,type,channel) +); diff --git a/setup/mysql/uptime.sql b/setup/mysql/uptime.sql new file mode 100644 index 0000000..373902a --- /dev/null +++ b/setup/mysql/uptime.sql @@ -0,0 +1,6 @@ +CREATE TABLE uptime ( + uptime INT UNSIGNED DEFAULT '0', # start. + endtime INT UNSIGNED DEFAULT '0', # end. + string VARCHAR(128) NOT NULL, + PRIMARY KEY (uptime) +); diff --git a/setup/pgsql/botmail.sql b/setup/pgsql/botmail.sql new file mode 100644 index 0000000..c87c2e4 --- /dev/null +++ b/setup/pgsql/botmail.sql @@ -0,0 +1,12 @@ +CREATE TABLE botmail ( + srcwho character varying(20) NOT NULL, + dstwho character varying(20) NOT NULL, + srcuh character varying(80) NOT NULL, + "time" numeric DEFAULT 0 NOT NULL, + msg text NOT NULL +) WITHOUT OIDS; + +REVOKE ALL ON TABLE botmail FROM PUBLIC; + +ALTER TABLE ONLY botmail + ADD CONSTRAINT botmail_pkey PRIMARY KEY (srcwho, dstwho); diff --git a/setup/pgsql/connections.sql b/setup/pgsql/connections.sql new file mode 100644 index 0000000..7b9872e --- /dev/null +++ b/setup/pgsql/connections.sql @@ -0,0 +1,13 @@ +CREATE TABLE connections ( + server character varying(30) NOT NULL, + port integer DEFAULT 6667 NOT NULL, + nick character varying(20) NOT NULL, + nickservpass character varying(8) NOT NULL, + ircname character varying(20) DEFAULT 'infobot IRC bot'::character varying NOT NULL, + timeadded numeric DEFAULT 0 +) WITHOUT OIDS; + +REVOKE ALL ON TABLE connections FROM PUBLIC; + +ALTER TABLE ONLY connections + ADD CONSTRAINT connections_pkey PRIMARY KEY (server, port, nick); diff --git a/setup/pgsql/factoids.sql b/setup/pgsql/factoids.sql new file mode 100644 index 0000000..7fc8d79 --- /dev/null +++ b/setup/pgsql/factoids.sql @@ -0,0 +1,20 @@ +CREATE TABLE factoids ( + factoid_key VARCHAR(64) NOT NULL, + requested_by VARCHAR(80) DEFAULT 'nobody' NOT NULL, + requested_time numeric(11) DEFAULT 0 NOT NULL, + requested_count numeric(5) DEFAULT 0 NOT NULL, + created_by VARCHAR(80), + created_time numeric(11) DEFAULT 0 NOT NULL, + modified_by VARCHAR(80), + modified_time numeric(11) DEFAULT 0 NOT NULL, + locked_by VARCHAR(80), + locked_time numeric(11) DEFAULT 0 NOT NULL, + factoid_value text NOT NULL +) WITHOUT OIDS; + +REVOKE ALL ON TABLE factoids FROM PUBLIC; + +CREATE INDEX factoids_idx_fvalue ON factoids USING hash (factoid_value); + +ALTER TABLE ONLY factoids + ADD CONSTRAINT factoids_pkey_fkey PRIMARY KEY (factoid_key); diff --git a/setup/pgsql/freshmeat.sql b/setup/pgsql/freshmeat.sql new file mode 100644 index 0000000..873e2dd --- /dev/null +++ b/setup/pgsql/freshmeat.sql @@ -0,0 +1,12 @@ +CREATE TABLE freshmeat ( + projectname_short VARCHAR(64) NOT NULL, + latest_version VARCHAR(32) DEFAULT 'none'::VARCHAR NOT NULL, + license VARCHAR(32), + url_homepage VARCHAR(128), + desc_short VARCHAR(96) NOT NULL +) WITHOUT OIDS; + +REVOKE ALL ON TABLE freshmeat FROM PUBLIC; + +ALTER TABLE ONLY freshmeat + ADD CONSTRAINT freshmeat_pkey PRIMARY KEY (projectname_short, latest_version); diff --git a/setup/pgsql/news.sql b/setup/pgsql/news.sql new file mode 100644 index 0000000..2924c61 --- /dev/null +++ b/setup/pgsql/news.sql @@ -0,0 +1,11 @@ +CREATE TABLE news ( + channel VARCHAR(16) NOT NULL, + id numeric DEFAULT 0 NOT NULL, + "key" VARCHAR(16) NOT NULL, + value text NOT NULL +) WITHOUT OIDS; + +REVOKE ALL ON TABLE news FROM PUBLIC; + +ALTER TABLE ONLY news + ADD CONSTRAINT news_pkey PRIMARY KEY (channel, id, "key"); diff --git a/setup/pgsql/onjoin.sql b/setup/pgsql/onjoin.sql new file mode 100644 index 0000000..2e7ed75 --- /dev/null +++ b/setup/pgsql/onjoin.sql @@ -0,0 +1,12 @@ +CREATE TABLE onjoin ( + nick VARCHAR(20) NOT NULL, + channel VARCHAR(16) NOT NULL, + message VARCHAR(255) NOT NULL, + modified_by VARCHAR(20) DEFAULT 'nobody' NOT NULL, + modified_time numeric DEFAULT 0 NOT NULL +) WITHOUT OIDS; + +REVOKE ALL ON TABLE onjoin FROM PUBLIC; + +ALTER TABLE ONLY onjoin + ADD CONSTRAINT onjoin_pkey PRIMARY KEY (nick, channel); diff --git a/setup/pgsql/rootwarn.sql b/setup/pgsql/rootwarn.sql new file mode 100644 index 0000000..6a843d8 --- /dev/null +++ b/setup/pgsql/rootwarn.sql @@ -0,0 +1,12 @@ +CREATE TABLE rootwarn ( + nick VARCHAR(20) NOT NULL, + attempt numeric, + "time" numeric NOT NULL, + host VARCHAR(80) NOT NULL, + channel VARCHAR(20) NOT NULL +) WITHOUT OIDS; + +REVOKE ALL ON TABLE rootwarn FROM PUBLIC; + +ALTER TABLE ONLY rootwarn + ADD CONSTRAINT rootwarn_pkey PRIMARY KEY (nick); diff --git a/setup/pgsql/seen.sql b/setup/pgsql/seen.sql new file mode 100644 index 0000000..550f5bf --- /dev/null +++ b/setup/pgsql/seen.sql @@ -0,0 +1,14 @@ +CREATE TABLE seen ( + nick VARCHAR(20) NOT NULL, + "time" numeric NOT NULL, + channel VARCHAR(20) NOT NULL, + host VARCHAR(80) NOT NULL, + message text NOT NULL, + hehcount numeric DEFAULT 0 NOT NULL, + messagecount numeric DEFAULT 0 NOT NULL +) WITHOUT OIDS; + +REVOKE ALL ON TABLE seen FROM PUBLIC; + +ALTER TABLE ONLY seen + ADD CONSTRAINT seen_pkey PRIMARY KEY (nick, channel); diff --git a/setup/pgsql/stats.sql b/setup/pgsql/stats.sql new file mode 100644 index 0000000..4af863d --- /dev/null +++ b/setup/pgsql/stats.sql @@ -0,0 +1,12 @@ +CREATE TABLE stats ( + nick VARCHAR(20) NOT NULL, + "type" VARCHAR(8) NOT NULL, + channel VARCHAR(16) DEFAULT 'PRIVATE' NOT NULL, + "time" numeric DEFAULT 0 NOT NULL, + counter numeric DEFAULT 0 +) WITHOUT OIDS; + +REVOKE ALL ON TABLE stats FROM PUBLIC; + +ALTER TABLE ONLY stats + ADD CONSTRAINT stats_pkey PRIMARY KEY (nick, "type", channel); diff --git a/setup/pgsql/uptime.sql b/setup/pgsql/uptime.sql new file mode 100644 index 0000000..49bcd63 --- /dev/null +++ b/setup/pgsql/uptime.sql @@ -0,0 +1,10 @@ +CREATE TABLE uptime ( + uptime numeric DEFAULT 0, + endtime numeric DEFAULT 0, + string VARCHAR(128) NOT NULL +) WITHOUT OIDS; + +REVOKE ALL ON TABLE uptime FROM PUBLIC; + +ALTER TABLE ONLY uptime + ADD CONSTRAINT uptime_pkey PRIMARY KEY (uptime); diff --git a/setup/setup.pl b/setup/setup.pl new file mode 100755 index 0000000..72ad985 --- /dev/null +++ b/setup/setup.pl @@ -0,0 +1,97 @@ +#!/usr/bin/perl +# setup_tables: setup MYSQL/PGSQL side of things for infobot. +# written by the xk. +### + +require "src/logger.pl"; +require "src/core.pl"; +require "src/modules.pl"; +require "src/Misc.pl"; +require "src/CLI/Support.pl"; + +$bot_src_dir = "src/"; + +# read param stuff from infobot.config. +&loadConfig("files/infobot.config"); + +&loadDBModules(); +my $dbname = $param{'DBName'}; +my $query; + +if ($dbname eq "") { + print "error: appears that the config file was not loaded properly.\n"; + exit 1; +} + +if ($param{'DBType'} =~ /mysql/i) { + use DBI; + + print "Enter root information...\n"; + # username. + print "Username: "; + chop (my $adminuser = ); + + # passwd. + system "stty -echo"; + print "Password: "; + chop(my $adminpass = ); + print "\n"; + system "stty echo"; + + if ($adminuser eq "" or $adminpass eq "") { + &ERROR("error: adminuser || adminpass is NULL."); + exit 1; + } + + &sqlOpenDB("mysql", "mysql", $adminuser, $adminpass); + + my $database_exists = 0; + foreach $database (&sqlRawReturn("SHOW DATABASES")) { + $database_exists++ if $database eq $param{DBName}; + } + if ($database_exists) { + &status("Database '$param{DBName}' already exists. Continuing..."); + } else { + &status("Creating db ..."); + &sqlRaw("create(database)", "CREATE DATABASE $param{DBName}"); + } + + &status("--- Adding user information for user '$param{'SQLUser'}'"); + + if (!&sqlSelect("user", "user", { 'user' => &sqlQuote($param{'SQLUser'}) })) { + &status("--- Adding user '$param{'SQLUser'}' $dbname/user table..."); + + $query = "INSERT INTO user VALUES ". + "('localhost', '$param{'SQLUser'}', ". + "password('$param{'SQLPass'}'), "; + + $query .= "'Y','Y','Y','Y','Y','Y','N','N','N','N','N','N','N','N')"; + + &sqlRaw("create(user)", $query); + } else { + &status("... user information already present."); + } + + if (!&sqlSelect("db", "db", { 'db' => &sqlQuote($param{'SQLUser'}) })) { + &status("--- Adding database information for database '$dbname'."); + + $query = "INSERT INTO db VALUES ". + "('localhost', '$dbname', ". + "'$param{'SQLUser'}', "; + + $query .= "'Y','Y','Y','Y','Y','Y','Y','N','N','N')"; + + &sqlRaw("create(db)", $query); + } else { + &status("... db info already present."); + } + + # flush. + &status("Flushing privileges..."); + $query = "FLUSH PRIVILEGES"; + &sqlRaw("mysql(flush)", $query); +} + +&status("Done."); + +&sqlCloseDB(); diff --git a/setup/sqlite/botmail.sql b/setup/sqlite/botmail.sql new file mode 100644 index 0000000..2789338 --- /dev/null +++ b/setup/sqlite/botmail.sql @@ -0,0 +1,8 @@ +CREATE TABLE botmail ( + srcwho VARCHAR(20) NOT NULL, + dstwho VARCHAR(20) NOT NULL, + srcuh VARCHAR(80) NOT NULL, + time INT UNSIGNED DEFAULT 'UNIX_TIMESTAMP()', + msg TEXT NOT NULL, + PRIMARY KEY (srcwho,dstwho) +); diff --git a/setup/sqlite/connections.sql b/setup/sqlite/connections.sql new file mode 100644 index 0000000..d1256c1 --- /dev/null +++ b/setup/sqlite/connections.sql @@ -0,0 +1,9 @@ +CREATE TABLE connections ( + server VARCHAR(30) NOT NULL, + port INT NOT NULL DEFAULT '6667', + nick VARCHAR(20) NOT NULL, + nickservpass VARCHAR(8) NOT NULL, + ircname VARCHAR (20) NOT NULL DEFAULT 'infobot experimental bot', + timeadded INT UNSIGNED DEFAULT 'UNIX_TIMESTAMP()', + PRIMARY KEY (server,port,nick) +); diff --git a/setup/sqlite/factoids.sql b/setup/sqlite/factoids.sql new file mode 100644 index 0000000..d5189d0 --- /dev/null +++ b/setup/sqlite/factoids.sql @@ -0,0 +1,14 @@ +CREATE TABLE factoids ( + factoid_key VARCHAR(64) NOT NULL, + requested_by VARCHAR(64) NOT NULL DEFAULT 'nobody', + requested_time INT NOT NULL DEFAULT '0', + requested_count SMALLINT UNSIGNED NOT NULL DEFAULT '0', + created_by VARCHAR(64), + created_time INT NOT NULL DEFAULT '0', + modified_by VARCHAR(192), + modified_time INT NOT NULL DEFAULT '0', + locked_by VARCHAR(64), + locked_time INT NOT NULL DEFAULT '0', + factoid_value TEXT NOT NULL, + PRIMARY KEY (factoid_key) +); diff --git a/setup/sqlite/freshmeat.sql b/setup/sqlite/freshmeat.sql new file mode 100644 index 0000000..4b4f42b --- /dev/null +++ b/setup/sqlite/freshmeat.sql @@ -0,0 +1,8 @@ +CREATE TABLE freshmeat ( + projectname_short VARCHAR(64) NOT NULL, + latest_version VARCHAR(32) DEFAULT 'none' NOT NULL, + license VARCHAR(32), + url_homepage VARCHAR(128), + desc_short VARCHAR(96) NOT NULL, + PRIMARY KEY (projectname_short,latest_version) +); diff --git a/setup/sqlite/news.sql b/setup/sqlite/news.sql new file mode 100644 index 0000000..ebfb0e2 --- /dev/null +++ b/setup/sqlite/news.sql @@ -0,0 +1,7 @@ +CREATE TABLE news ( + channel VARCHAR(16) NOT NULL, + id INT UNSIGNED DEFAULT '0', + key VARCHAR(16) NOT NULL, + value TEXT NOT NULL, # limit to ~450 or so. + PRIMARY KEY (channel,id,key) +); diff --git a/setup/sqlite/onjoin.sql b/setup/sqlite/onjoin.sql new file mode 100644 index 0000000..994cc54 --- /dev/null +++ b/setup/sqlite/onjoin.sql @@ -0,0 +1,14 @@ +CREATE TABLE onjoin ( + nick VARCHAR(20) NOT NULL, + channel VARCHAR(16) NOT NULL, + message VARCHAR(255) NOT NULL, + modified_by VARCHAR(20) NOT NULL DEFAULT 'nobody', + modified_time INT NOT NULL DEFAULT '0', + PRIMARY KEY (nick, channel) +); + +-- v.2 -> v.3 +-- ALTER TABLE onjoin ADD COLUMN modified_by VARCHAR(20) NOT NULL DEFAULT 'nobody'; +-- ALTER TABLE onjoin ADD COLUMN modified_time INT NOT NULL DEFAULT '0'; +-- ** the following doesn't work for sqlite ** +-- ALTER TABLE onjoin ADD PRIMARY KEY (nick, channel); diff --git a/setup/sqlite/rootwarn.sql b/setup/sqlite/rootwarn.sql new file mode 100644 index 0000000..afcee2c --- /dev/null +++ b/setup/sqlite/rootwarn.sql @@ -0,0 +1,8 @@ +CREATE TABLE rootwarn ( + nick VARCHAR(20) NOT NULL, + attempt SMALLINT UNSIGNED, + time INT NOT NULL, + host VARCHAR(80) NOT NULL, + channel VARCHAR(20) NOT NULL, + PRIMARY KEY (nick) +); diff --git a/setup/sqlite/seen.sql b/setup/sqlite/seen.sql new file mode 100644 index 0000000..d920f79 --- /dev/null +++ b/setup/sqlite/seen.sql @@ -0,0 +1,8 @@ +CREATE TABLE seen ( + nick VARCHAR(20) NOT NULL, + time INT NOT NULL, + channel VARCHAR(20) NOT NULL, + host VARCHAR(80) NOT NULL, + message TINYTEXT NOT NULL, + PRIMARY KEY (nick,channel) +); diff --git a/setup/sqlite/stats.sql b/setup/sqlite/stats.sql new file mode 100644 index 0000000..97f773c --- /dev/null +++ b/setup/sqlite/stats.sql @@ -0,0 +1,8 @@ +CREATE TABLE stats ( + nick VARCHAR(20) NOT NULL, + type VARCHAR(8) NOT NULL, + channel VARCHAR(16) NOT NULL DEFAULT "PRIVATE", + time INT UNSIGNED DEFAULT 'UNIX_TIMESTAMP()', + counter SMALLINT UNSIGNED DEFAULT '0', + PRIMARY KEY (nick,type,channel) +); diff --git a/setup/sqlite/uptime.sql b/setup/sqlite/uptime.sql new file mode 100644 index 0000000..373902a --- /dev/null +++ b/setup/sqlite/uptime.sql @@ -0,0 +1,6 @@ +CREATE TABLE uptime ( + uptime INT UNSIGNED DEFAULT '0', # start. + endtime INT UNSIGNED DEFAULT '0', # end. + string VARCHAR(128) NOT NULL, + PRIMARY KEY (uptime) +); diff --git a/setup/sqlite2/botmail.sql b/setup/sqlite2/botmail.sql new file mode 100644 index 0000000..2789338 --- /dev/null +++ b/setup/sqlite2/botmail.sql @@ -0,0 +1,8 @@ +CREATE TABLE botmail ( + srcwho VARCHAR(20) NOT NULL, + dstwho VARCHAR(20) NOT NULL, + srcuh VARCHAR(80) NOT NULL, + time INT UNSIGNED DEFAULT 'UNIX_TIMESTAMP()', + msg TEXT NOT NULL, + PRIMARY KEY (srcwho,dstwho) +); diff --git a/setup/sqlite2/connections.sql b/setup/sqlite2/connections.sql new file mode 100644 index 0000000..d1256c1 --- /dev/null +++ b/setup/sqlite2/connections.sql @@ -0,0 +1,9 @@ +CREATE TABLE connections ( + server VARCHAR(30) NOT NULL, + port INT NOT NULL DEFAULT '6667', + nick VARCHAR(20) NOT NULL, + nickservpass VARCHAR(8) NOT NULL, + ircname VARCHAR (20) NOT NULL DEFAULT 'infobot experimental bot', + timeadded INT UNSIGNED DEFAULT 'UNIX_TIMESTAMP()', + PRIMARY KEY (server,port,nick) +); diff --git a/setup/sqlite2/factoids.sql b/setup/sqlite2/factoids.sql new file mode 100644 index 0000000..d5189d0 --- /dev/null +++ b/setup/sqlite2/factoids.sql @@ -0,0 +1,14 @@ +CREATE TABLE factoids ( + factoid_key VARCHAR(64) NOT NULL, + requested_by VARCHAR(64) NOT NULL DEFAULT 'nobody', + requested_time INT NOT NULL DEFAULT '0', + requested_count SMALLINT UNSIGNED NOT NULL DEFAULT '0', + created_by VARCHAR(64), + created_time INT NOT NULL DEFAULT '0', + modified_by VARCHAR(192), + modified_time INT NOT NULL DEFAULT '0', + locked_by VARCHAR(64), + locked_time INT NOT NULL DEFAULT '0', + factoid_value TEXT NOT NULL, + PRIMARY KEY (factoid_key) +); diff --git a/setup/sqlite2/freshmeat.sql b/setup/sqlite2/freshmeat.sql new file mode 100644 index 0000000..4b4f42b --- /dev/null +++ b/setup/sqlite2/freshmeat.sql @@ -0,0 +1,8 @@ +CREATE TABLE freshmeat ( + projectname_short VARCHAR(64) NOT NULL, + latest_version VARCHAR(32) DEFAULT 'none' NOT NULL, + license VARCHAR(32), + url_homepage VARCHAR(128), + desc_short VARCHAR(96) NOT NULL, + PRIMARY KEY (projectname_short,latest_version) +); diff --git a/setup/sqlite2/news.sql b/setup/sqlite2/news.sql new file mode 100644 index 0000000..ebfb0e2 --- /dev/null +++ b/setup/sqlite2/news.sql @@ -0,0 +1,7 @@ +CREATE TABLE news ( + channel VARCHAR(16) NOT NULL, + id INT UNSIGNED DEFAULT '0', + key VARCHAR(16) NOT NULL, + value TEXT NOT NULL, # limit to ~450 or so. + PRIMARY KEY (channel,id,key) +); diff --git a/setup/sqlite2/onjoin.sql b/setup/sqlite2/onjoin.sql new file mode 100644 index 0000000..994cc54 --- /dev/null +++ b/setup/sqlite2/onjoin.sql @@ -0,0 +1,14 @@ +CREATE TABLE onjoin ( + nick VARCHAR(20) NOT NULL, + channel VARCHAR(16) NOT NULL, + message VARCHAR(255) NOT NULL, + modified_by VARCHAR(20) NOT NULL DEFAULT 'nobody', + modified_time INT NOT NULL DEFAULT '0', + PRIMARY KEY (nick, channel) +); + +-- v.2 -> v.3 +-- ALTER TABLE onjoin ADD COLUMN modified_by VARCHAR(20) NOT NULL DEFAULT 'nobody'; +-- ALTER TABLE onjoin ADD COLUMN modified_time INT NOT NULL DEFAULT '0'; +-- ** the following doesn't work for sqlite ** +-- ALTER TABLE onjoin ADD PRIMARY KEY (nick, channel); diff --git a/setup/sqlite2/rootwarn.sql b/setup/sqlite2/rootwarn.sql new file mode 100644 index 0000000..afcee2c --- /dev/null +++ b/setup/sqlite2/rootwarn.sql @@ -0,0 +1,8 @@ +CREATE TABLE rootwarn ( + nick VARCHAR(20) NOT NULL, + attempt SMALLINT UNSIGNED, + time INT NOT NULL, + host VARCHAR(80) NOT NULL, + channel VARCHAR(20) NOT NULL, + PRIMARY KEY (nick) +); diff --git a/setup/sqlite2/seen.sql b/setup/sqlite2/seen.sql new file mode 100644 index 0000000..d920f79 --- /dev/null +++ b/setup/sqlite2/seen.sql @@ -0,0 +1,8 @@ +CREATE TABLE seen ( + nick VARCHAR(20) NOT NULL, + time INT NOT NULL, + channel VARCHAR(20) NOT NULL, + host VARCHAR(80) NOT NULL, + message TINYTEXT NOT NULL, + PRIMARY KEY (nick,channel) +); diff --git a/setup/sqlite2/stats.sql b/setup/sqlite2/stats.sql new file mode 100644 index 0000000..97f773c --- /dev/null +++ b/setup/sqlite2/stats.sql @@ -0,0 +1,8 @@ +CREATE TABLE stats ( + nick VARCHAR(20) NOT NULL, + type VARCHAR(8) NOT NULL, + channel VARCHAR(16) NOT NULL DEFAULT "PRIVATE", + time INT UNSIGNED DEFAULT 'UNIX_TIMESTAMP()', + counter SMALLINT UNSIGNED DEFAULT '0', + PRIMARY KEY (nick,type,channel) +); diff --git a/setup/sqlite2/uptime.sql b/setup/sqlite2/uptime.sql new file mode 100644 index 0000000..373902a --- /dev/null +++ b/setup/sqlite2/uptime.sql @@ -0,0 +1,6 @@ +CREATE TABLE uptime ( + uptime INT UNSIGNED DEFAULT '0', # start. + endtime INT UNSIGNED DEFAULT '0', # end. + string VARCHAR(128) NOT NULL, + PRIMARY KEY (uptime) +); diff --git a/src/CLI/Support.pl b/src/CLI/Support.pl new file mode 100644 index 0000000..60f171c --- /dev/null +++ b/src/CLI/Support.pl @@ -0,0 +1,103 @@ +# +# CLI/Support.pl: Stubs for functions that are from IRC/* +# Author: Tim Riker +# Version: v0.1 (20021028) +# Created: 20021028 +# +use strict; + +my $postprocess; + +use vars qw($uh $message); + +sub cliloop { + &status("Using CLI..."); + &status("Now type what you want."); + + $nuh = "local!local\@local"; + $uh = "local\@local"; + $who = 'local'; + $orig{who} = 'local'; + $ident = $param{'ircUser'}; + $chan = $talkchannel = "_local"; + $addressed = 1; + $msgType = 'private'; + $host = 'local'; + + # install libterm-readline-gnu-perl to get history support + use Term::ReadLine; + my $term = new Term::ReadLine 'infobot'; + my $prompt = "$who> "; + #$OUT = $term->OUT || STDOUT; + while ( defined ($_ = $term->readline($prompt)) ) { + $orig{message} = $_; + $message = $_; + chomp $message; + last if ($message =~ m/^quit$/); + $_ = &process() if $message; + } + &doExit(); +} + +sub msg { + my ($nick, $msg) = @_; + if (!defined $nick) { + &ERROR("msg: nick == NULL."); + return; + } + + if (!defined $msg) { + $msg ||= 'NULL'; + &WARN("msg: msg == $msg."); + return; + } + + if ( $postprocess ) { + undef $postprocess; + } elsif ($postprocess = &getChanConf('postprocess', $talkchannel)) { + &DEBUG("say: $postprocess $msg"); + &parseCmdHook($postprocess . ' ' . $msg); + undef $postprocess; + return; + } + + &status(">$nick< $msg"); + + print("$nick: $msg\n"); +} + +# Usage: &action(nick || chan, txt); +sub action { + my ($target, $txt) = @_; + if (!defined $txt) { + &WARN("action: txt == NULL."); + return; + } + + if (length $txt > 480) { + &status("action: txt too long; truncating."); + chop($txt) while (length $txt > 480); + } + + &status("* $ident/$target $txt"); +} + +sub IsNickInChan { + my ($nick,$chan) = @_; + return 1; +} + +sub performStrictReply { + &msg($who, @_); +} + +sub performReply { + &msg($who, @_); +} + +sub performAddressedReply { + return unless ($addressed); + &msg($who, @_); +} + +1; diff --git a/src/CommandStubs.pl b/src/CommandStubs.pl new file mode 100644 index 0000000..d086c48 --- /dev/null +++ b/src/CommandStubs.pl @@ -0,0 +1,916 @@ +# +# User Command Extension Stubs +# WARN: this file does not reload on HUP. +# + +#use strict; # TODO: sub { \&{ $hash{'CODEREF'} }($flatarg) }; + +use vars qw($who $msgType $conn $chan $message $ident $talkchannel + $bot_version $bot_data_dir); +use vars qw(@vernick @vernicktodo); +use vars qw(%channels %cache %mask %userstats %myModules %cmdstats + %cmdhooks %lang %ver); +# TODO: FIX THE FOLLOWING: +use vars qw($total $x $type $i $good %wingateToDo); + +### COMMAND HOOK IMPLEMENTATION. +# addCmdHook('TEXT_HOOK', +# (CODEREF => 'Blah', +# Forker => 1, +# Module => 'blah.pl' # preload module. +# Identifier => 'config_label', # change to Config? +# Help => 'help_label', +# Cmdstats => 'text_label',) +#} +### + +sub addCmdHook { + my ($ident, %hash) = @_; + + if (exists $cmdhooks{$ident}) { + &WARN("aCH: \$cmdhooks{$ident} already exists."); + return; + } + + &VERB("aCH: added $ident",2); # use $hash{'Identifier'}? + ### hrm... prevent warnings? + $cmdhooks{$ident} = \%hash; +} + +# RUN IF ADDRESSED. +sub parseCmdHook { + my ($line) = @_; + $line =~ s/^\s+|\s+$//g; # again. + $line =~ /^(\S+)(\s+(.*))?$/; + my $cmd = $1; # command name is whitespaceless. + my $flatarg = $3; + my @args = split(/\s+/, $flatarg || ''); + my $done = 0; + + &shmFlush(); + + if (!defined %cmdhooks) { + &WARN('%cmdhooks does not exist.'); + return 0; + } + + if (!defined $cmd) { + &WARN('cstubs: cmd == NULL.'); + return 0; + } + + foreach (keys %cmdhooks) { + # rename to something else! like $id or $label? + my $ident = $_; + + next unless ($cmd =~ /^$ident$/i); + + if ($done) { + &WARN("pCH: Multiple hook match: $ident"); + next; + } + + &status("cmdhooks: $cmd matched '$ident' '$flatarg'"); + my %hash = %{ $cmdhooks{$ident} }; + + if (!scalar keys %hash) { + &WARN('CmdHook: hash is NULL?'); + return 1; + } + + if ($hash{NoArgs} and $flatarg) { + &DEBUG("cmd $ident does not take args ('$flatarg'); skipping."); + next; + } + + if (!exists $hash{CODEREF}) { + &ERROR("CODEREF undefined for $cmd or $ident."); + return 1; + } + + ### DEBUG. + foreach (keys %hash) { + &VERB(" $cmd->$_ => '$hash{$_}'.",2); + } + + ### HELP. + if (exists $hash{'Help'} and !scalar(@args)) { + &help( $hash{'Help'} ); + return 1; + } + + ### IDENTIFIER. + if (exists $hash{'Identifier'}) { + return 1 unless (&IsChanConfOrWarn($hash{'Identifier'})); + } + + ### USER FLAGS. + if (exists $hash{'UserFlag'}) { + return 1 unless (&hasFlag($hash{'UserFlag'})); + } + + ### FORKER,IDENTIFIER,CODEREF. + if (($$ == $bot_pid) && exists $hash{'Forker'}) { + if (exists $hash{'ArrayArgs'}) { + &Forker($hash{'Identifier'}, sub { \&{ $hash{'CODEREF'} }(@args) } ); + } else { + &Forker($hash{'Identifier'}, sub { \&{ $hash{'CODEREF'} }($flatarg) } ); + } + + } else { + if (exists $hash{'Module'}) { + &loadMyModule($hash{'Module'}); + } + + # check if CODEREF exists. + if (!defined &{ $hash{'CODEREF'} }) { + &WARN("coderef $hash{'CODEREF'} does not exist."); + if (defined $who) { + &msg($who, "coderef does not exist for $ident."); + } + + return 1; + } + + if (exists $hash{'ArrayArgs'}) { + &{ $hash{'CODEREF'} }(@args); + } else { + &{ $hash{'CODEREF'} }($flatarg); + } + } + + ### CMDSTATS. + if (exists $hash{'Cmdstats'}) { + $cmdstats{ $hash{'Cmdstats'} }++; + } + + &VERB('hooks: End of command.',2); + + $done = 1; + } + + return 1 if ($done); + return 0; +} + +sub Modules { + if (!defined $message) { + &WARN('Modules: message is undefined. should never happen.'); + return; + } + + my $debiancmd = 'conflicts?|depends?|desc|file|(?:d)?info|provides?'; + $debiancmd .= '|recommends?|suggests?|maint|maintainer'; + + if ($message =~ /^($debiancmd)(\s+(.*))?$/i) { + return unless (&IsChanConfOrWarn('Debian')); + my $package = lc $3; + + if (defined $package) { + &Forker('Debian', sub { &Debian::infoPackages($1, $package); } ); + } else { + &help($1); + } + + return; + } + + # google searching. Simon++ + my $w3search_regex = 'google'; + if ($message =~ /^(?:search\s+)?($w3search_regex)\s+(?:for\s+)?['"]?(.*?)["']?\s*\?*$/i) { + return unless (&IsChanConfOrWarn('W3Search')); + + &Forker('W3Search', sub { &W3Search::W3Search($1,$2); } ); + + $cmdstats{'W3Search'}++; + return; + } + + # text counters. (eg: hehstats) + my $itc; + $itc = &getChanConf('ircTextCounters'); + $itc = &findChanConf('ircTextCounters') unless ($itc); + return if ($itc && &do_text_counters($itc) == 1); + # end of text counters. + + # list{keys|values}. xk++. Idea taken from #linuxwarez@EFNET + if ($message =~ /^list(\S+)(\s+(.*))?$/i) { + return unless (&IsChanConfOrWarn('Search')); + + my $thiscmd = lc $1; + my $args = $3 || ''; + + $thiscmd =~ s/^vals$/values/; + return if ($thiscmd ne 'keys' && $thiscmd ne 'values'); + + # Usage: + if (!defined $args or $args =~ /^\s*$/) { + &help('list'. $thiscmd); + return; + } + + # suggested by asuffield and \broken. + if ($args =~ /^["']/ and $args =~ /["']$/) { + &DEBUG('list*: removed quotes.'); + $args =~ s/^["']|["']$//g; + } + + if (length $args < 2 && &IsFlag('o') ne 'o') { + &msg($who, 'search string is too short.'); + return; + } + + &Forker('Search', sub { &Search::Search($thiscmd, $args); } ); + + $cmdstats{'Factoid Search'}++; + return; + } + + # Topic management. xk++ + # may want to add a userflags for topic. -xk + if ($message =~ /^topic(\s+(.*))?$/i) { + return unless (&IsChanConfOrWarn('Topic')); + + my $chan = $talkchannel; + my @args = split / /, $2 || ''; + + if (!scalar @args) { + &msg($who,"Try 'help topic'"); + return; + } + + $chan = lc(shift @args) if ($msgType eq 'private'); + my $thiscmd = shift @args; + + # topic over public: + if ($msgType eq 'public' && $thiscmd =~ /^#/) { + &msg($who, 'error: channel argument is not required.'); + &msg($who, "\002Usage\002: topic "); + return; + } + + # topic over private: + if ($msgType eq 'private' && $chan !~ /^#/) { + &msg($who, 'error: channel argument is required.'); + &msg($who, "\002Usage\002: topic #channel "); + return; + } + + if (&validChan($chan) == 0) { + &msg($who,"error: invalid channel \002$chan\002"); + return; + } + + # for semi-outsiders. + if (!&IsNickInChan($who,$chan)) { + &msg($who, "Failed. You ($who) are not in $chan, hey?"); + return; + } + + # now lets do it. + &loadMyModule('Topic'); + &Topic($chan, $thiscmd, join(' ', @args)); + $cmdstats{'Topic'}++; + return; + } + + # wingate. + if ($message =~ /^wingate$/i) { + return unless (&IsChanConfOrWarn('Wingate')); + + my $reply = "Wingate statistics: scanned \002" + .scalar(keys %wingateToDo)."\002 hosts"; + my $queue = scalar(keys %wingateToDo); + if ($queue) { + $reply .= ". I have \002$queue\002 hosts in the queue"; + $reply .= '. Started the scan '.&Time2String(time() - $wingaterun).' ago'; + } + + &performStrictReply("$reply."); + + return; + } + + # do nothing and let the other routines have a go + return 'CONTINUE'; +} + +# Uptime. xk++ +sub uptime { + my $count = 1; + &msg($who, "- Uptime for $ident -"); + &msg($who, "Now: ". &Time2String(&uptimeNow()) ." running $bot_version"); + + foreach (&uptimeGetInfo()) { + /^(\d+)\.\d+ (.*)/; + my $time = &Time2String($1); + my $info = $2; + + &msg($who, "$count: $time $2"); + $count++; + } +} + +# seen. +sub seen { + my($person) = lc shift; + $person =~ s/\?*$//; + + if (!defined $person or $person =~ /^$/) { + &help('seen'); + + my $i = &countKeys('seen'); + &msg($who,'there '. &fixPlural('is',$i) ." \002$i\002 ". + 'seen '. &fixPlural('entry',$i) .' that I know of.'); + + return; + } + + my @seen; + + &seenFlush(); # very evil hack. oh well, better safe than sorry. + + # TODO: convert to &sqlSelectRowHash(); + my $select = 'nick,time,channel,host,message'; + if ($person eq 'random') { + @seen = &randKey('seen', $select); + } else { + @seen = &sqlSelect('seen', $select, { nick => $person } ); + } + + if (scalar @seen < 2) { + foreach (@seen) { + &DEBUG("seen: _ => '$_'."); + } + &performReply("i haven't seen '$person'"); + return; + } + + # valid seen. + my $reply; + ### TODO: multi channel support. may require &IsNick() to return + ### all channels or something. + + my @chans = &getNickInChans($seen[0]); + if (scalar @chans) { + $reply = "$seen[0] is currently on"; + + foreach (@chans) { + $reply .= ' '.$_; + next unless (exists $userstats{lc $seen[0]}{'Join'}); + $reply .= ' ('.&Time2String(time() - $userstats{lc $seen[0]}{'Join'}).')'; + } + + if (&IsChanConf('seenStats') > 0) { + my $i; + $i = $userstats{lc $seen[0]}{'Count'}; + $reply .= ". Has said a total of \002$i\002 messages" if (defined $i); + $i = $userstats{lc $seen[0]}{'Time'}; + $reply .= '. Is idling for '.&Time2String(time() - $i) if (defined $i); + } + $reply .= ", last said\002:\002 '$seen[4]'."; + } else { + my $howlong = &Time2String(time() - $seen[1]); + $reply = "$seen[0] <$seen[3]> was last seen on IRC ". + "in channel $seen[2], $howlong ago, ". + "saying\002:\002 '$seen[4]'."; + } + + &performStrictReply($reply); + return; +} + +# User Information Services. requested by Flugh. +sub userinfo { + my ($arg) = join(' ',@_); + + if ($arg =~ /^set(\s+(.*))?$/i) { + $arg = $2; + if (!defined $arg) { + &help('userinfo set'); + return; + } + + &UserInfoSet(split /\s+/, $arg, 2); + } elsif ($arg =~ /^unset(\s+(.*))?$/i) { + $arg = $2; + if (!defined $arg) { + &help('userinfo unset'); + return; + } + + &UserInfoSet($arg, ''); + } else { + &UserInfoGet($arg); + } +} + +# cookie (random). xk++ +sub cookie { + my ($arg) = @_; + + # lets find that secret cookie. + my $target = ($msgType ne 'public') ? $who : $talkchannel; + my $cookiemsg = &getRandom(keys %{ $lang{'cookie'} }); + my ($key,$value); + + ### WILL CHEW TONS OF MEM. + ### TODO: convert this to a Forker function! + if ($arg) { + my @list = &searchTable('factoids', 'factoid_key', 'factoid_value', $arg); + $key = &getRandom(@list); + $value = &getFactInfo($key, 'factoid_value'); + } else { + ($key,$value) = &randKey('factoids','factoid_key,factoid_value'); + } + + for ($cookiemsg) { + s/##KEY/\002$key\002/; + s/##VALUE/$value/; + s/##WHO/$who/; + s/\$who/$who/; # cheap fix. + s/(\S+)?\s*<\S+>/$1 /; + s/\s+/ /g; + } + + if ($cookiemsg =~ s/^ACTION //i) { + &action($target, $cookiemsg); + } else { + &msg($target, $cookiemsg); + } +} + +sub convert { + my $arg = join(' ',@_); + my ($from,$to) = ('',''); + + ($from,$to) = ($1,$2) if ($arg =~ /^(.*?) to (.*)$/i); + ($from,$to) = ($2,$1) if ($arg =~ /^(.*?) from (.*)$/i); + + if (!$to or !$from) { + &msg($who, 'Invalid format!'); + &help('convert'); + return; + } + + &Units::convertUnits($from, $to); + + return; +} + +sub lart { + my ($target) = &fixString($_[0]); + my $extra = 0; + my $chan = $talkchannel; + my ($for); + my $mynick = $conn->nick(); + + if ($msgType eq 'private') { + if ($target =~ /^($mask{chan})\s+(.*)$/) { + $chan = $1; + $target = $2; + $extra = 1; + } else { + &msg($who, 'error: invalid format or missing arguments.'); + &help('lart'); + return; + } + } + if ($target =~ /^(.*)(\s+for\s+.*)$/) { + $target = $1; + $for = $2; + } + + my $line = &getRandomLineFromFile($bot_data_dir. '/infobot.lart'); + if (defined $line) { + if ($target =~ /^(me|you|itself|\Q$mynick\E)$/i) { + $line =~ s/WHO/$who/g; + } else { + $line =~ s/WHO/$target/g; + } + $line .= $for if ($for); + $line .= ", courtesy of $who" if ($extra); + + &action($chan, $line); + } else { + &status('lart: error reading file?'); + } +} + +sub DebianNew { + my $idx = 'debian/Packages-sid.idx'; + my $error = 0; + my %pkg; + my @new; + + $error++ unless ( -e $idx); + $error++ unless ( -e "$idx-old"); + + if ($error) { + $error = 'no sid/sid-old index file found.'; + &ERROR("Debian: $error"); + &msg($who, $error); + return; + } + + open(IDX1, $idx); + open(IDX2, "$idx-old"); + + while () { + chop; + next if (/^\*/); + + $pkg{$_} = 1; + } + close IDX2; + + open(IDX1,$idx); + while () { + chop; + next if (/^\*/); + next if (exists $pkg{$_}); + + push(@new, $_); + } + close IDX1; + + &::performStrictReply( &::formListReply(0, 'New debian packages:', @new) ); +} + +sub do_verstats { + my ($chan) = @_; + + if (!defined $chan) { + &help('verstats'); + return; + } + + if (!&validChan($chan)) { + &msg($who, "chan $chan is invalid."); + return; + } + + if (scalar @vernick > scalar(keys %{ $channels{lc $chan}{''} })/4) { + &msg($who, 'verstats already in progress for someone else.'); + return; + } + + &msg($who, "Sending CTCP VERSION to $chan; results in 60s."); + $conn->ctcp('VERSION', $chan); + $cache{verstats}{chan} = $chan; + $cache{verstats}{who} = $who; + $cache{verstats}{msgType} = $msgType; + + $conn->schedule(30, sub { + my $c = lc $cache{verstats}{chan}; + @vernicktodo = (); + + foreach (keys %{ $channels{$c}{''} } ) { + next if (grep /^\Q$_\E$/i, @vernick); + push(@vernicktodo, $_); + } + + &verstats_flush(); + } ); + + $conn->schedule(60, sub { + my $vtotal = 0; + my $c = lc $cache{verstats}{chan}; + my $total = keys %{ $channels{$c}{''} }; + $chan = $c; + $who = $cache{verstats}{who}; + $msgType = $cache{verstats}{msgType}; + delete $cache{verstats}; # sufficient? + + foreach (keys %ver) { + $vtotal += scalar keys %{ $ver{$_} }; + } + + my %sorted; + my $unknown = $total - $vtotal; + my $perc = sprintf("%.1f", $unknown * 100 / $total); + $perc =~ s/.0$//; + $sorted{$perc}{'unknown/cloak'} = "$unknown ($perc%)" if ($unknown); + + foreach (keys %ver) { + my $count = scalar keys %{ $ver{$_} }; + $perc = sprintf("%.01f", $count * 100 / $total); + $perc =~ s/.0$//; # lame compression. + + $sorted{$perc}{$_} = "$count ($perc%)"; + } + + ### can be compressed to a map? + my @list; + foreach ( sort { $b <=> $a } keys %sorted ) { + my $perc = $_; + foreach (sort keys %{ $sorted{$perc} }) { + push(@list, "$_ - $sorted{$perc}{$_}"); + } + } + + # hack. this is one major downside to scheduling. + $chan = $c; + &performStrictReply( &formListReply(0, "IRC Client versions for $c ", @list) ); + + # clean up not-needed data structures. + undef %ver; + undef @vernick; + } ); + + return; +} + +sub verstats_flush { + for (1..5) { + last unless (scalar @vernicktodo); + + my $n = shift(@vernicktodo); + $conn->ctcp('VERSION', $n); + } + + return unless (scalar @vernicktodo); + + $conn->schedule(3, \&verstats_flush() ); +} + +sub do_text_counters { + my ($itc) = @_; + $itc =~ s/([^\w\s])/\\$1/g; + my $z = join '|', split ' ', $itc; + + if ($msgType eq 'privmsg' and $message =~ / ($mask{chan})$/) { + &DEBUG("ircTC: privmsg detected; chan = $1"); + $chan = $1; + } + + if ($message =~ /^_stats(\s+(\S+))$/i) { + &textstats_main($2); + return 1; + } + + my ($type,$arg); + if ($message =~ /^($z)stats(\s+(\S+))?$/i) { + $type = $1; + $arg = $3; + } else { + return 0; + } + + # even more uglier with channel/time arguments. + my $c = $chan; +# my $c = $chan || 'PRIVATE'; + my $where = 'type='.&sqlQuote($type); + if (defined $c) { + &DEBUG("c => $c"); + $where .= ' AND channel='.&sqlQuote($c) if (defined $c); + } else { + &DEBUG('not using chan arg'); + } + + my $sum = (&sqlRawReturn('SELECT SUM(counter) FROM stats' + .' WHERE '.$where ))[0]; + + if (!defined $arg or $arg =~ /^\s*$/) { + # this is way ugly. + + # TODO: convert $where to hash + my %hash = &sqlSelectColHash('stats', 'nick,counter', + { }, + $where.' ORDER BY counter DESC LIMIT 3', 1 + ); + my $i; + my @top; + + # unfortunately we have to sort it again! + my $tp = 0; + foreach $i (sort { $b <=> $a } keys %hash) { + foreach (keys %{ $hash{$i} }) { + my $p = sprintf("%.01f", 100*$i/$sum); + $tp += $p; + push(@top, "\002$_\002 -- $i ($p%)"); + } + } + my $topstr = ''; + if (scalar @top) { + $topstr = '. Top '.scalar(@top).': '.join(', ', @top); + } + + if (defined $sum) { + &performStrictReply("total count of \037$type\037 on \002$c\002: $sum$topstr"); + } else { + &performStrictReply("zero counter for \037$type\037."); + } + } else { + # TODO: convert $where to hash and use a sqlSelect + my $x = (&sqlRawReturn('SELECT SUM(counter) FROM stats'. + " WHERE $where AND nick=".&sqlQuote($arg) ))[0]; + + if (!defined $x) { # !defined. + &performStrictReply("$arg has not said $type yet."); + return 1; + } + + # defined. + # TODO: convert $where to hash + my @array = &sqlSelect('stats', 'nick', undef, + $where.' ORDER BY counter', 1 + ); + my $good = 0; + my $i = 0; + for ($i=0; $i $c } : ''; + my $sum = &sqlSelect('stats', 'SUM(counter)', $where_href); + + if (!defined $arg or $arg =~ /^\s*$/) { + # this is way ugly. + &DEBUG('_stats: !arg'); + + my %hash = &sqlSelectColHash('stats', 'nick,counter', + $where_href, + ' ORDER BY counter DESC LIMIT 3', 1 + ); + my $i; + my @top; + + # unfortunately we have to sort it again! + my $tp = 0; + foreach $i (sort { $b <=> $a } keys %hash) { + foreach (keys %{ $hash{$i} }) { + my $p = sprintf("%.01f", 100*$i/$sum); + $tp += $p; + push(@top, "\002$_\002 -- $i ($p%)"); + } + } + + my $topstr = ''; + if (scalar @top) { + $topstr = '. Top '.scalar(@top).': '.join(', ', @top); + } + + if (defined $sum) { + &performStrictReply("total count of \037$type\037 on \002$c\002: $sum$topstr"); + } else { + &performStrictReply("zero counter for \037$type\037."); + } + + return; + } + + # TODO: add nick to where_href + my %hash = &sqlSelectColHash('stats', 'type,counter', + $where_href, ' AND nick='.&sqlQuote($arg) + ); + + # this is totally messed up... needs to be fixed... and cleaned up. + my $total; + my $good; + my $ii; + my $x; + + foreach (keys %hash) { + &DEBUG("_stats: hash{$_} => $hash{$_}"); + # ranking. + # TODO: convert $where to hash + my $where = ''; + my @array = &sqlSelect('stats', 'nick', undef, $where.' ORDER BY counter', 1); + $good = 0; + $ii = 0; + for(my $i=0; $i $i, good => $good, total => $total"); + $x .= ' '.$total.'blah blah'; + } + +# return; + + if (!defined $x) { # !defined. + &performStrictReply("$arg has not said $type yet."); + return; + } + + my $xtra = ''; + if ($total and $good) { + my $pct = sprintf("%.01f", 100*(1+$total-$ii)/$total); + $xtra = ", ranked $ii\002/\002$total (percentile: \002$pct\002 %)"; + } + + my $pct1 = sprintf("%.01f", 100*$x/$sum); + &performStrictReply("\002$arg\002 has said \037$type\037 \002$x\002 times (\002$pct1\002 %)$xtra"); +} + +sub nullski { + my ($arg) = @_; + return unless (defined $arg); + # big security hole + #foreach (`$arg`) { &msg($who,$_); } +} + +%cmdhooks=(); +### +### START ADDING HOOKS. +### +&addCmdHook('(babel(fish)?|x|xlate|translate)', ('CODEREF' => 'babelfish::babelfish', 'Identifier' => 'babelfish', 'Cmdstats' => 'babelfish', 'Forker' => 1, 'Help' => 'babelfish', 'Module' => 'babelfish') ); +&addCmdHook('(botmail|message)', ('CODEREF' => 'botmail::parse', 'Identifier' => 'botmail', 'Cmdstats' => 'botmail') ); +&addCmdHook('bzflist17', ('CODEREF' => 'BZFlag::list17', 'Identifier' => 'BZFlag', 'Cmdstats' => 'BZFlag', 'Forker' => 1, 'Module' => 'BZFlag') ); +&addCmdHook('bzflist', ('CODEREF' => 'BZFlag::list', 'Identifier' => 'BZFlag', 'Cmdstats' => 'BZFlag', 'Forker' => 1, 'Module' => 'BZFlag') ); +&addCmdHook('bzfquery', ('CODEREF' => 'BZFlag::query', 'Identifier' => 'BZFlag', 'Cmdstats' => 'BZFlag', 'Forker' => 1, 'Module' => 'BZFlag') ); +&addCmdHook('chan(stats|info)', ('CODEREF' => 'chaninfo', ) ); +&addCmdHook('cmd(stats|info)', ('CODEREF' => 'cmdstats', ) ); +&addCmdHook('convert', ('CODEREF' => 'convert', 'Forker' => 1, 'Identifier' => 'Units', 'Help' => 'convert') ); +&addCmdHook('(cookie|random)', ('CODEREF' => 'cookie', 'Forker' => 1, 'Identifier' => 'Factoids') ); +&addCmdHook('countdown', ('CODEREF' => 'countdown', 'Module' => 'countdown', 'Identifier' => 'countdown', 'Cmdstats' => 'countdown') ); +&addCmdHook('countrystats', ('CODEREF' => 'countryStats') ); +&addCmdHook('dauthor', ('CODEREF' => 'Debian::searchAuthor', 'Forker' => 1, 'Identifier' => 'Debian', 'Cmdstats' => 'Debian Author Search', 'Help' => 'dauthor' ) ); +&addCmdHook('d?bugs', ('CODEREF' => 'DebianExtra::Parse', 'Forker' => 1, 'Identifier' => 'DebianExtra', 'Cmdstats' => 'Debian Bugs') ); +&addCmdHook('d?contents', ('CODEREF' => 'Debian::searchContents', 'Forker' => 1, 'Identifier' => 'Debian', 'Cmdstats' => 'Debian Contents Search', 'Help' => 'contents' ) ); +&addCmdHook('d?find', ('CODEREF' => 'Debian::DebianFind', 'Forker' => 1, 'Identifier' => 'Debian', 'Cmdstats' => 'Debian Search', 'Help' => 'find' ) ); +&addCmdHook('dice', ('CODEREF' => 'dice::dice', 'Identifier' => 'dice', 'Cmdstats' => 'dice', 'Forker' => 1, 'Module' => 'dice') ); +&addCmdHook('Dict', ('CODEREF' => 'Dict::Dict', 'Identifier' => 'Dict', 'Help' => 'dict', 'Forker' => 1, 'Cmdstats' => 'Dict') ); +&addCmdHook('dincoming', ('CODEREF' => 'Debian::generateIncoming', 'Forker' => 1, 'Identifier' => 'Debian' ) ); +&addCmdHook('dnew', ('CODEREF' => 'DebianNew', 'Identifier' => 'Debian' ) ); +&addCmdHook('dns|d?nslookup', ('CODEREF' => 'dns::query', 'Identifier' => 'dns', 'Cmdstats' => 'dns', 'Forker' => 1, 'Help' => 'dns') ); +&addCmdHook('(d|search)desc', ('CODEREF' => 'Debian::searchDescFE', 'Forker' => 1, 'Identifier' => 'Debian', 'Cmdstats' => 'Debian Desc Search', 'Help' => 'ddesc' ) ); +&addCmdHook('dstats', ('CODEREF' => 'Debian::infoStats', 'Forker' => 1, 'Identifier' => 'Debian', 'Cmdstats' => 'Debian Statistics' ) ); +&addCmdHook('(ex)?change', ('CODEREF' => 'Exchange::query', 'Identifier' => 'Exchange', 'Cmdstats' => 'Exchange', 'Forker' => 1) ); +&addCmdHook('factinfo', ('CODEREF' => 'factinfo', 'Cmdstats' => 'Factoid Info', Module => 'Factoids', ) ); +&addCmdHook('factstats?', ('CODEREF' => 'factstats', 'Cmdstats' => 'Factoid Stats', Help => 'factstats', Forker => 1, 'Identifier' => 'Factoids', ) ); +&addCmdHook('help', ('CODEREF' => 'help', 'Cmdstats' => 'Help', ) ); +&addCmdHook('HTTPDtype', ('CODEREF' => 'HTTPDtype::HTTPDtype', 'Identifier' => 'HTTPDtype', 'Cmdstats' => 'HTTPDtype', 'Forker' => 1) ); +&addCmdHook('[ia]?spell', ('CODEREF' => 'spell::query', 'Identifier' => 'spell', 'Cmdstats' => 'spell', 'Forker' => 1, 'Help' => 'spell') ); +&addCmdHook('insult', ('CODEREF' => 'Insult::Insult', 'Forker' => 1, 'Identifier' => 'insult', 'Help' => 'insult' ) ); +&addCmdHook('karma', ('CODEREF' => 'karma', ) ); +&addCmdHook('kernel', ('CODEREF' => 'Kernel::Kernel', 'Forker' => 1, 'Identifier' => 'Kernel', 'Cmdstats' => 'Kernel', 'NoArgs' => 1) ); +&addCmdHook('lart', ('CODEREF' => 'lart', 'Identifier' => 'lart', 'Help' => 'lart') ); +&addCmdHook('lc', ('CODEREF' => 'case::lower', 'Identifier' => 'case', 'Cmdstats' => 'case', 'Forker' => 1, 'Module' => 'case') ); +&addCmdHook('listauth', ('CODEREF' => 'CmdListAuth', 'Identifier' => 'Search', Module => 'Factoids', 'Help' => 'listauth') ); +&addCmdHook('md5(sum)?', ('CODEREF' => 'md5::md5', 'Identifier' => 'md5', 'Cmdstats' => 'md5', 'Forker' => 1, 'Module' => 'md5') ); +&addCmdHook('metar', ('CODEREF' => 'Weather::Metar', 'Identifier' => 'Weather', 'Help' => 'weather', 'Cmdstats' => 'Weather', 'Forker' => 1) ); +&addCmdHook('News', ('CODEREF' => 'News::Parse', Module => 'News', 'Cmdstats' => 'News' ) ); +&addCmdHook('(?:nick|lame)ometer(?: for)?', ('CODEREF' => 'nickometer::query', 'Identifier' => 'nickometer', 'Cmdstats' => 'nickometer', 'Forker' => 1) ); +&addCmdHook('nullski', ('CODEREF' => 'nullski', ) ); +&addCmdHook('page', ('CODEREF' => 'pager::page', 'Identifier' => 'pager', 'Cmdstats' => 'pager', 'Forker' => 1, 'Help' => 'page') ); +&addCmdHook('piglatin', ('CODEREF' => 'piglatin::piglatin', 'Identifier' => 'piglatin', 'Cmdstats' => 'piglatin', 'Forker' => 1) ); +&addCmdHook('Plug', ('CODEREF' => 'Plug::Plug', 'Identifier' => 'Plug', 'Forker' => 1, 'Cmdstats' => 'Plug') ); +&addCmdHook('quote', ('CODEREF' => 'Quote::Quote', 'Forker' => 1, 'Identifier' => 'Quote', 'Help' => 'quote', 'Cmdstats' => 'Quote') ); +&addCmdHook('reverse', ('CODEREF' => 'reverse::reverse', 'Identifier' => 'reverse', 'Cmdstats' => 'reverse', 'Forker' => 1, 'Module' => 'reverse') ); +&addCmdHook('RootWarn', ('CODEREF' => 'CmdrootWarn', 'Identifier' => 'RootWarn', 'Module' => 'RootWarn') ); +&addCmdHook('OnJoin', ('CODEREF' => 'Cmdonjoin', 'Identifier' => 'OnJoin', 'Module' => 'OnJoin') ); +&addCmdHook('Rss', ('CODEREF' => 'Rss::Rss', 'Identifier' => 'Rss', 'Cmdstats' => 'Rss', 'Forker' => 1, 'Help' => 'rss') ); +&addCmdHook('sched(stats|info)', ('CODEREF' => 'scheduleList', ) ); +&addCmdHook('scramble', ('CODEREF' => 'scramble::scramble', 'Identifier' => 'scramble', 'Cmdstats' => 'scramble', 'Forker' => 1, 'Module' => 'scramble') ); +&addCmdHook('seen', ('CODEREF' => 'seen', 'Identifier' => 'seen') ); +&addCmdHook('slashdot', ('CODEREF' => 'Slashdot::Slashdot', 'Identifier' => 'slashdot', 'Forker' => 1, 'Cmdstats' => 'slashdot') ); +&addCmdHook('tell|explain', ('CODEREF' => 'tell', Help => 'tell', Identifier => 'allowTelling', Cmdstats => 'Tell') ); +&addCmdHook('uc', ('CODEREF' => 'case::upper', 'Identifier' => 'case', 'Cmdstats' => 'case', 'Forker' => 1, 'Module' => 'case') ); +&addCmdHook('Uptime', ('CODEREF' => 'uptime', 'Identifier' => 'Uptime', 'Cmdstats' => 'Uptime') ); +&addCmdHook('u(ser)?info', ('CODEREF' => 'userinfo', 'Identifier' => 'UserInfo', 'Help' => 'userinfo', 'Module' => 'UserInfo') ); +&addCmdHook('verstats', ('CODEREF' => 'do_verstats' ) ); +&addCmdHook('Weather', ('CODEREF' => 'Weather::Weather', 'Identifier' => 'Weather', 'Help' => 'weather', 'Cmdstats' => 'Weather', 'Forker' => 1, 'Module' => 'Weather') ); +&addCmdHook('wiki(pedia)?', ('CODEREF' => 'wikipedia::wikipedia', 'Identifier' => 'wikipedia', 'Cmdstats' => 'wikipedia', 'Forker' => 1, 'Help' => 'wikipedia', 'Module' => 'wikipedia') ); +&addCmdHook('wtf', ('CODEREF' => 'wtf::query', 'Identifier' => 'wtf', 'Cmdstats' => 'wtf', 'Forker' => 1, 'Help' => 'wtf', 'Module' => 'wtf') ); +&addCmdHook('zfi', ('CODEREF' => 'zfi::query', 'Identifier' => 'zfi', 'Cmdstats' => 'zfi', 'Forker' => 1, 'Module' => 'zfi') ); +&addCmdHook('(zippy|yow)', ('CODEREF' => 'zippy::get', 'Identifier' => 'Zippy', 'Cmdstats' => 'Zippy', 'Forker' => 1, 'Module' => 'Zippy') ); +&addCmdHook('zsi', ('CODEREF' => 'zsi::query', 'Identifier' => 'zsi', 'Cmdstats' => 'zsi', 'Forker' => 1, 'Module' => 'zsi') ); +### +### END OF ADDING HOOKS. +### + +&status('loaded '.scalar(keys %cmdhooks).' command hooks.'); + +1; diff --git a/src/DynaConfig.pl b/src/DynaConfig.pl new file mode 100644 index 0000000..de814b4 --- /dev/null +++ b/src/DynaConfig.pl @@ -0,0 +1,844 @@ +# +# DynaConfig.pl: Read/Write configuration files dynamically. +# Author: dms +# Version: v0.1 (20010120) +# Created: 20010119 +# NOTE: Merged from User.pl +# + +use strict; + +use vars qw(%chanconf %cache %bans %channels %nuh %users %ignore + %talkWho %dcc %mask); +use vars qw($utime_userfile $ucount_userfile $utime_chanfile $who + $ucount_chanfile $userHandle $chan $msgType $talkchannel + $ident $bot_state_dir $talkWho $flag_quit $wtime_userfile + $wcount_userfile $wtime_chanfile $nuh $message); + +##### +##### USERFILE CONFIGURATION READER/WRITER +##### + +sub readUserFile { + my $f = "$bot_state_dir/infobot.users"; + + if (! -f $f) { + &DEBUG("userfile not found; new fresh run detected."); + return; + } + + if ( -f $f and -f "$f~") { + my $s1 = -s $f; + my $s2 = -s "$f~"; + + if ($s2 > $s1*3) { + &FIXME("rUF: backup file bigger than current file."); + } + } + + if (!open IN, $f) { + &ERROR("Cannot read userfile ($f): $!"); + &closeLog(); + exit 1; + } + + undef %users; # clear on reload. + undef %bans; # reset. + undef %ignore; # reset. + + my $ver = ; + if ($ver !~ /^#v1/) { + &ERROR("old or invalid user file found."); + &closeLog(); + exit 1; # correct? + } + + my $nick; + my $type; + while () { + chop; + + next if /^$/; + next if /^#/; + + if (/^--(\S+)[\s\t]+(.*)$/) { # user: middle entry. + my ($what,$val) = ($1,$2); + + if (!defined $val or $val eq '') { + &WARN("$what: val == NULL."); + next; + } + + if (!defined $nick) { + &WARN("DynaConfig: invalid line: $_"); + next; + } + + # nice little hack. + if ($what eq 'HOSTS') { + $users{$nick}{$what}{$val} = 1; + } else { + $users{$nick}{$what} = $val; + } + + } elsif (/^(\S+)$/) { # user: start entry. + $nick = $1; + + } elsif (/^::(\S+) ignore$/) { # ignore: start entry. + $chan = $1; + $type = 'ignore'; + + } elsif (/^- (\S+):\+(\d+):\+(\d+):(\S+):(.*)$/ and $type eq 'ignore') { + ### ignore: middle entry. + my $mask = $1; + my(@array) = ($2,$3,$4,$5); + ### DEBUG purposes only! + if ($mask !~ /^$mask{nuh}$/) { + &WARN("ignore: mask $mask is invalid."); + next; + } + $ignore{$chan}{$mask} = \@array; + + } elsif (/^::(\S+) bans$/) { # bans: start entry. + $chan = $1; + $type = 'bans'; + + } elsif (/^- (\S+):\+(\d+):\+(\d+):(\d+):(\S+):(.*)$/ and $type eq 'bans') { + ### bans: middle entry. + # $btime, $atime, $count, $whoby, $reason. + my(@array) = ($2,$3,$4,$5,$6); + $bans{$chan}{$1} = \@array; + + } else { # unknown. + &WARN("unknown line: $_"); + } + } + close IN; + + &status( sprintf("USERFILE: Loaded: %d users, %d bans, %d ignore", + scalar(keys %users)-1, + scalar(keys %bans), # ?? + scalar(keys %ignore), # ?? + ) + ); +} + +sub writeUserFile { + if (!scalar keys %users) { + &DEBUG("wUF: nothing to write."); + return; + } + + if (!open OUT,">$bot_state_dir/infobot.users") { + &ERROR("Cannot write userfile ($bot_state_dir/infobot.users): $!"); + return; + } + + my $time = scalar(gmtime); + + print OUT "#v1: infobot -- $ident -- written $time\n\n"; + + ### USER LIST. + my $cusers = 0; + foreach (sort keys %users) { + my $user = $_; + $cusers++; + my $count = scalar keys %{ $users{$user} }; + if (!$count) { + &WARN("user $user has no other attributes; skipping."); + next; + } + + print OUT "$user\n"; + + foreach (sort keys %{ $users{$user} }) { + my $what = $_; + my $val = $users{$user}{$_}; + + if (ref($val) eq 'HASH') { + foreach (sort keys %{ $users{$user}{$_} }) { + print OUT "--$what\t\t$_\n"; + } + + } elsif ($_ eq 'FLAGS') { + print OUT "--$_\t\t" . join('', sort split('', $val)) . "\n"; + } else { + print OUT "--$_\t\t$val\n"; + } + } + print OUT "\n"; + } + + ### BAN LIST. + my $cbans = 0; + foreach (keys %bans) { + my $chan = $_; + $cbans++; + + my $count = scalar keys %{ $bans{$chan} }; + if (!$count) { + &WARN("bans: chan $chan has no other attributes; skipping."); + next; + } + + print OUT "::$chan bans\n"; + foreach (keys %{ $bans{$chan} }) { +# format: bans: mask expire time-added count who-added reason + my @array = @{ $bans{$chan}{$_} }; + if (scalar @array != 5) { + &WARN("bans: $chan/$_ is corrupted."); + next; + } + + printf OUT "- %s:+%d:+%d:%d:%s:%s\n", $_, @array; + } + } + print OUT "\n" if ($cbans); + + ### IGNORE LIST. + my $cignore = 0; + foreach (keys %ignore) { + my $chan = $_; + $cignore++; + + my $count = scalar keys %{ $ignore{$chan} }; + if (!$count) { + &WARN("ignore: chan $chan has no other attributes; skipping."); + next; + } + + ### TODO: use hash instead of array for flexibility? + print OUT "::$chan ignore\n"; + foreach (keys %{ $ignore{$chan} }) { +# format: ignore: mask expire time-added who-added reason + my @array = @{ $ignore{$chan}{$_} }; + if (scalar @array != 4) { + &WARN("ignore: $chan/$_ is corrupted."); + next; + } + + printf OUT "- %s:+%d:+%d:%s:%s\n", $_, @array; + } + } + + close OUT; + + $wtime_userfile = time(); + &status("--- Saved USERFILE ($cusers users; $cbans bans; $cignore ignore) at $time"); + if (defined $msgType and $msgType =~ /^chat$/) { + &performStrictReply("--- Writing user file..."); + } +} + +##### +##### CHANNEL CONFIGURATION READER/WRITER +##### + +sub readChanFile { + my $f = "$bot_state_dir/infobot.chan"; + if ( -f $f and -f "$f~") { + my $s1 = -s $f; + my $s2 = -s "$f~"; + + if ($s2 > $s1*3) { + &FIXME("rCF: backup file bigger than current file."); + } + } + + if (!open IN, $f) { + &ERROR("Cannot read chanfile ($f): $!"); + return; + } + + undef %chanconf; # reset. + + $_ = ; # version string. + + my $chan; + while () { + chop; + + next if /^\s*$/; + next if /^\// or /^\;/; # / or ; are comment lines. + + if (/^(\S+)\s*$/) { + $chan = $1; + next; + } + next unless (defined $chan); + + if (/^[\s\t]+\+(\S+)$/) { # bool, true. + $chanconf{$chan}{$1} = 1; + + } elsif (/^[\s\t]+\-(\S+)$/) { # bool, false. + # although this is supported in run-time configuration. + $chanconf{$chan}{$1} = 0; + + } elsif (/^[\s\t]+(\S+)[\s\t]+(.*)$/) {# what = val. + $chanconf{$chan}{$1} = $2; + + } else { + &WARN("unknown line: $_") unless (/^#/); + } + } + close IN; + + # verify configuration + ### TODO: check against valid params. + foreach $chan (keys %chanconf) { + foreach (keys %{ $chanconf{$chan} }) { + next unless /^[+-]/; + + &WARN("invalid param: chanconf{$chan}{$_}; removing."); + delete $chanconf{$chan}{$_}; + undef $chanconf{$chan}{$_}; + } + } + + &status("CHANFILE: Loaded: ".(scalar(keys %chanconf)-1)." chans"); +} + +sub writeChanFile { + if (!scalar keys %chanconf) { + &DEBUG("wCF: nothing to write."); + return; + } + + if (!open OUT,">$bot_state_dir/infobot.chan") { + &ERROR("Cannot write chanfile ($bot_state_dir/infobot.chan): $!"); + return; + } + + my $time = scalar(gmtime); + print OUT "#v1: infobot -- $ident -- written $time\n\n"; + + if ($flag_quit) { + + ### Process 1: if defined in _default, remove same definition + ### from non-default channels. + foreach (keys %{ $chanconf{_default} }) { + my $opt = $_; + my $val = $chanconf{_default}{$opt}; + my @chans; + + foreach (keys %chanconf) { + $chan = $_; + + next if ($chan eq "_default"); + next unless (exists $chanconf{$chan}{$opt}); + next unless ($val eq $chanconf{$chan}{$opt}); + + push(@chans,$chan); + delete $chanconf{$chan}{$opt}; + } + + if (scalar @chans) { + &DEBUG("Removed config $opt to @chans since it's defiend in '_default'"); + } + } + + ### Process 2: if defined in all chans but _default, set in + ### _default and remove all others. + my (%optsval, %opts); + foreach (keys %chanconf) { + $chan = $_; + next if ($chan eq "_default"); + my $opt; + + foreach (keys %{ $chanconf{$chan} }) { + $opt = $_; + if (exists $optsval{$opt} and $optsval{$opt} eq $chanconf{$chan}{$opt}) { + $opts{$opt}++; + next; + } + $optsval{$opt} = $chanconf{$chan}{$opt}; + $opts{$opt} = 1; + } + } + + foreach (keys %opts) { + next unless ($opts{$_} > 2); + &DEBUG(" opts{$_} => $opts{$_}"); + } + + ### other optimizations are in UserDCC.pl + } + + ### lets do it... + foreach (sort keys %chanconf) { + $chan = $_; + + print OUT "$chan\n"; + + foreach (sort keys %{ $chanconf{$chan} }) { + my $val = $chanconf{$chan}{$_}; + + if ($val =~ /^0$/) { # bool, false. + print OUT " -$_\n"; + + } elsif ($val =~ /^1$/) { # bool, true. + print OUT " +$_\n"; + + } else { # what = val. + print OUT " $_ $val\n"; + + } + + } + print OUT "\n"; + } + + close OUT; + + $wtime_chanfile = time(); + &status("--- Saved CHANFILE (".scalar(keys %chanconf). + " chans) at $time"); + + if (defined $msgType and $msgType =~ /^chat$/) { + &performStrictReply("--- Writing chan file..."); + } +} + +##### +##### USER COMMANDS. +##### + +# TODO: support multiple flags. +# TODO: return all flags for opers +sub IsFlag { + my $flags = shift; + my ($ret, $f, $o) = ''; + + &verifyUser($who, $nuh); + + foreach $f (split //, $users{$userHandle}{FLAGS}) { + foreach $o ( split //, $flags ) { + next unless ($f eq $o); + + $ret = $f; + last; + } + } + + $ret; +} + +sub verifyUser { + my ($nick, $lnuh) = @_; + my ($user, $m); + + if ($userHandle = $dcc{'CHATvrfy'}{$who}) { + &VERB("vUser: cached auth for $who.",2); + return $userHandle; + } + + $userHandle = ''; + + foreach $user (keys %users) { + next if ($user eq "_default"); + + foreach $m (keys %{ $users{$user}{HOSTS} }) { + $m =~ s/\?/./g; + $m =~ s/\*/.*?/g; + $m =~ s/([\@\(\)\[\]])/\\$1/g; + + next unless ($lnuh =~ /^$m$/i); + + if ($user !~ /^\Q$nick\E$/i and !exists $cache{VUSERWARN}{$user}) { + &status("vU: host matched but diff nick ($nick != $user)."); + $cache{VUSERWARN}{$user} = 1; + } + + $userHandle = $user; + last; + } + + last if ($userHandle ne ''); + + if ($user =~ /^\Q$nick\E$/i and !exists $cache{VUSERWARN}{$user}) { + &status("vU: nick matched but host is not in list ($lnuh)."); + $cache{VUSERWARN}{$user} = 1; + } + } + + $userHandle ||= "_default"; + # what's talkchannel for? + $talkWho{$talkchannel} = $who if (defined $talkchannel); + $talkWho = $who; + + return $userHandle; +} + +sub ckpasswd { + # returns true if arg1 encrypts to arg2 + my ($plain, $encrypted) = @_; + if ($encrypted eq '') { + ($plain, $encrypted) = split(/\s+/, $plain, 2); + } + return 0 unless ($plain ne '' and $encrypted ne ''); + + # MD5 // DES. Bobby Billingsley++. + my $salt; + if ($encrypted =~ /^(\S{2})/ and length $encrypted == 13) { + $salt = $1; + } elsif ($encrypted =~ /^\$\d\$(\w\w)\$/) { + $salt = $1; + } else { + &DEBUG("unknown salt from $encrypted."); + return 0; + } + + return ($encrypted eq crypt($plain, $salt)); +} + +# mainly for dcc chat... hrm. +sub hasFlag { + my ($flag) = @_; + + if (&IsFlag($flag) eq $flag) { + return 1; + } else { + &status("DCC CHAT: <$who> $message -- not enough flags."); + &performStrictReply("error: you do not have enough flags for that. ($flag required)"); + return 0; + } +} + +# expire is time in minutes +sub ignoreAdd { + my($mask,$chan,$expire,$comment) = @_; + + $chan ||= '*'; # global if undefined. + $comment ||= ''; # optional. + $expire ||= 0; # permament. + my $count ||= 0; + + if ($expire > 0) { + $expire = ($expire*60) + time(); + } else { + $expire = 0; + } + + my $exist = 0; + $exist++ if (exists $ignore{$chan}{$mask}); + + $ignore{$chan}{$mask} = [$expire, time(), $who, $comment]; + + # TODO: improve this. + if ($expire == 0) { + &status("ignore: Added $mask for $chan to NEVER expire, by $who, for $comment"); + } else { + &status("ignore: Added $mask for $chan to expire $expire mins, by $who, for $comment"); + } + + if ($exist) { + $utime_userfile = time(); + $ucount_userfile++; + + return 2; + } else { + return 1; + } +} + +sub ignoreDel { + my($mask) = @_; + my @match; + + ### TODO: support wildcards. + foreach (keys %ignore) { + my $chan = $_; + + foreach (grep /^\Q$mask\E$/i, keys %{ $ignore{$chan} }) { + delete $ignore{$chan}{$mask}; + push(@match,$chan); + } + + &DEBUG("iD: scalar => ".scalar(keys %{ $ignore{$chan} }) ); + } + + if (scalar @match) { + $utime_userfile = time(); + $ucount_userfile++; + } + + return @match; +} + +sub userAdd { + my($nick,$mask) = @_; + + if (exists $users{$nick}) { + return 0; + } + + $utime_userfile = time(); + $ucount_userfile++; + + if (defined $mask and $mask !~ /^\s*$/) { + &DEBUG("userAdd: mask => $mask"); + $users{$nick}{HOSTS}{$mask} = 1; + } + + $users{$nick}{FLAGS} ||= $users{_default}{FLAGS}; + + return 1; +} + +sub userDel { + my($nick) = @_; + + if (!exists $users{$nick}) { + return 0; + } + + $utime_userfile = time(); + $ucount_userfile++; + + delete $users{$nick}; + + return 1; +} + +sub banAdd { + my($mask,$chan,$expire,$reason) = @_; + + $chan ||= '*'; + $expire ||= 0; + + if ($expire > 0) { + $expire = $expire*60 + time(); + } + + my $exist = 1; + $exist++ if (exists $bans{$chan}{$mask} or + exists $bans{'*'}{$mask}); + $bans{$chan}{$mask} = [$expire, time(), 0, $who, $reason]; + + my @chans = ($chan eq '*') ? keys %channels : $chan; + my $m = $mask; + $m =~ s/\?/\\./g; + $m =~ s/\*/\\S*/g; + foreach (@chans) { + my $chan = $_; + foreach (keys %{ $channels{$chan}{''} }) { + next unless (exists $nuh{lc $_}); + next unless ($nuh{lc $_} =~ /^$m$/i); + &FIXME("nuh{$_} =~ /$m/"); + } + } + + if ($exist == 1) { + $utime_userfile = time(); + $ucount_userfile++; + } + + return $exist; +} + +sub banDel { + my($mask) = @_; + my @match; + + foreach (keys %bans) { + my $chan = $_; + + foreach (grep /^\Q$mask\E$/i, keys %{ $bans{$chan} }) { + delete $bans{$chan}{$_}; + push(@match, $chan); + } + + &DEBUG("bans: scalar => ".scalar(keys %{ $bans{$chan} }) ); + } + + if (scalar @match) { + $utime_userfile = time(); + $ucount_userfile++; + } + + return @match; +} + +sub IsUser { + my($user) = @_; + + if ( &getUser($user) ) { + return 1; + } else { + return 0; + } +} + +sub getUser { + my($user) = @_; + + if (!defined $user) { + &WARN("getUser: user == NULL."); + return; + } + + if (my @retval = grep /^\Q$user\E$/i, keys %users) { + if ($retval[0] ne $user) { + &WARN("getUser: retval[0] ne user ($retval[0] ne $user)"); + } + my $count = scalar keys %{ $users{$retval[0]} }; + &DEBUG("count => $count."); + + return $retval[0]; + } else { + return; + } +} + +sub chanSet { + my($cmd, $chan, $what, $val) = @_; + + if ($cmd eq "+chan") { + if (exists $chanconf{$chan}) { + &performStrictReply("chan $chan already exists."); + return; + } + $chanconf{$chan}{_time_added} = time(); + $chanconf{$chan}{autojoin} = $conn->nick(); + + &performStrictReply("Joining $chan..."); + &joinchan($chan); + + return; + } + + if (!exists $chanconf{$chan}) { + &performStrictReply("no such channel $chan"); + return; + } + + my $update = 0; + + if (defined $what and $what =~ s/^([+-])(\S+)/$2/) { + ### ".chanset +blah" + ### ".chanset +blah 10" -- error. + + my $set = ($1 eq "+") ? 1 : 0; + my $was = $chanconf{$chan}{$what}; + + if ($set) { # add/set. + if (defined $was and $was eq '1') { + &performStrictReply("setting $what for $chan already 1."); + return; + } + + $val = 1; + + } else { # delete/unset. + if (!defined $was) { + &performStrictReply("setting $what for $chan is not set."); + return; + } + + $val = 0; + } + + # alter for cosmetic (print out) reasons only. + $was = (defined $was) ? "; was '$was'" : ''; + + if ($val eq '0') { + &performStrictReply("Unsetting $what for $chan$was."); + delete $chanconf{$chan}{$what}; + } else { + &performStrictReply("Setting $what for $chan to '$val'$was."); + $chanconf{$chan}{$what} = $val; + } + + $update++; + + } elsif (defined $val) { + ### ".chanset blah testing" + + my $was = $chanconf{$chan}{$what}; + if (defined $was and $was eq $val) { + &performStrictReply("setting $what for $chan already '$val'."); + return; + } + $was = ($was) ? "; was '$was'" : ''; + &performStrictReply("Setting $what for $chan to '$val'$was."); + + $chanconf{$chan}{$what} = $val; + + $update++; + + } else { # read only. + ### ".chanset" + ### ".chanset blah" + + if (!defined $what) { + &WARN("chanset/DC: what == undefine."); + return; + } + + if (exists $chanconf{$chan}{$what}) { + &performStrictReply("$what for $chan is '$chanconf{$chan}{$what}'"); + } else { + &performStrictReply("$what for $chan is not set."); + } + } + + if ($update) { + $utime_chanfile = time(); + $ucount_chanfile++; + } + + return; +} + +sub rehashConfVars { + # this is an attempt to fix where an option is enabled but the module + # has been not loaded. it also can be used for other things. + + foreach (keys %{ $cache{confvars} }) { + my $i = $cache{confvars}{$_}; + &DEBUG("rehashConfVars: _ => $_"); + + if (/^news$/ and $i) { + &loadMyModule('News'); + delete $cache{confvars}{$_}; + } + + if (/^uptime$/ and $i) { + &loadMyModule('Uptime'); + delete $cache{confvars}{$_}; + } + + if (/^rootwarn$/i and $i) { + &loadMyModule('RootWarn'); + delete $cache{confvars}{$_}; + } + + if (/^onjoin$/i and $i) { + &loadMyModule('OnJoin'); + delete $cache{confvars}{$_}; + } + } + + &DEBUG("end of rehashConfVars"); + + delete $cache{confvars}; +} + +my @regFlagsUser = ( + # possible chars to include in FLAG + 'A', # bot administration over /msg + # default is only via DCC CHAT + 'O', # dynamic ops (as on channel). (automatic +o) + 'T', # add topics. + 'a', # ask/request factoid. + 'm', # modify factoid. (includes renaming) + 'n', # bot owner, can 'reload' + 'o', # master of bot (automatic +amrt) + # can search on factoid strings shorter than 2 chars + # can tell bot to join new channels + # can [un]lock factoids + 'r', # remove factoid. + 't', # teach/add factoid. +); + +1; diff --git a/src/Factoids/Core.pl b/src/Factoids/Core.pl new file mode 100644 index 0000000..a43a3d6 --- /dev/null +++ b/src/Factoids/Core.pl @@ -0,0 +1,542 @@ +# +# Misc.pl: Miscellaneous stuff. +# Author: dms +# Version: v0.1 (20010906) +# Created: 20010906 +# + +# use strict; # TODO + +use vars qw(%param %cache %lang %cmdstats %bots); +use vars qw($message $who $addressed $chan $h $nuh $ident $msgType + $correction_plausable); + +# Usage: &validFactoid($lhs,$rhs); +sub validFactoid { + my ($lhs,$rhs) = @_; + my $valid = 0; + + for (lc $lhs) { + # allow the following only if they have been made on purpose. + if ($rhs ne '' and $rhs !~ /^/ and last; # '=>'. + /\;\;/ and last; # ';;'. + /\|\|/ and last; # '||'. + + /^\Q$ident\E[\'\,\: ]/ and last;# dupe addressed. + /^[\-\, ]/ and last; + /\\$/ and last; # forgot shift for '?'. + /^all / and last; + /^also / and last; + / also$/ and last; + / and$/ and last; + /^because / and last; + /^but / and last; + /^gives / and last; + /^h(is|er) / and last; + /^if / and last; + / is,/ and last; + / it$/ and last; + /^or / and last; + / says$/ and last; + /^should / and last; + /^so / and last; + /^supposedly/ and last; + /^to / and last; + /^was / and last; + / which$/ and last; + + # nasty bug I introduced _somehow_, probably by fixMySQLBug(). + /\\\%/ and last; + /\\\_/ and last; + + # weird/special stuff. also old blootbot or stock infobot bugs. + $rhs =~ /( \Q$ident\E's|\Q$ident\E's )/i and last; # ownership. + + # duplication. + $rhs =~ /^\Q$lhs /i and last; + last if ($rhs =~ /^is /i and / is$/); + + $valid++; + } + + return $valid; +} + +sub FactoidStuff { + # inter-infobot. + if ($msgType =~ /private/ and $message =~ s/^:INFOBOT://) { + ### identification. + &status("infobot <$nuh> identified") unless $bots{$nuh}; + $bots{$nuh} = $who; + + ### communication. + + # query. + if ($message =~ /^QUERY (<.*?>) (.*)/) { # query. + my ($target,$item) = ($1,$2); + $item =~ s/[.\?]$//; + + &status(":INFOBOT:QUERY $who: $message"); + + if ($_ = &getFactoid($item)) { + &msg($who, ":INFOBOT:REPLY $target $item =is=> $_"); + } + + return 'INFOBOT QUERY'; + } elsif ($message =~ /^REPLY <(.*?)> (.*)/) { # reply. + my ($target,$item) = ($1,$2); + + &status(":INFOBOT:REPLY $who: $message"); + + my ($lhs,$mhs,$rhs) = $item =~ /^(.*?) =(.*?)=> (.*)/; + + if ($param{'acceptUrl'} !~ /REQUIRE/ or $rhs =~ /(http|ftp|mailto|telnet|file):/) { + &msg($target, "$who knew: $lhs $mhs $rhs"); + + # 'are' hack :) + $rhs = " are" if ($mhs eq 'are'); + &setFactInfo($lhs, 'factoid_value', $rhs); + } + + return 'INFOBOT REPLY'; + } else { + &ERROR(":INFOBOT:UNKNOWN $who: $message"); + return 'INFOBOT UNKNOWN'; + } + } + + # factoid forget. + if ($message =~ s/^forget\s+//i) { + return 'forget: no addr' unless ($addressed); + + my $faqtoid = $message; + if ($faqtoid eq '') { + &help('forget'); + return; + } + + $faqtoid =~ tr/A-Z/a-z/; + my $result = &getFactoid($faqtoid); + + # if it doesn't exist, well... it doesn't! + if (!defined $result) { + &performReply("i didn't have anything called '$faqtoid' to forget"); + return; + } + + # TODO: squeeze 3 getFactInfo calls into one? + my $author = &getFactInfo($faqtoid, 'created_by'); + my $count = &getFactInfo($faqtoid, 'requested_count') || 0; + # don't delete if requested $limit times + my $limit = &getChanConfDefault('factoidPreventForgetLimit', 100, $chan); + # don't delete if older than $limitage seconds (modified by requests below) + my $limitage = &getChanConfDefault('factoidPreventForgetLimitTime', 7 * 24 * 60 * 60, $chan); + my $t = &getFactInfo($faqtoid, 'created_time') || 0; + my $age = time() - $t; + + # lets scale limitage from 1 (nearly 0) to $limit (full time). + $limitage = $limitage*($count+1)/$limit if ($count < $limit); + # isauthor and isop. + my $isau = (defined $author and &IsHostMatch($author) == 2) ? 1 : 0; + my $isop = (&IsFlag('o') eq 'o') ? 1 : 0; + + if (IsFlag('r') ne 'r' && !$isop) { + &msg($who, "you don't have access to remove factoids"); + return; + } + + return 'locked factoid' if (&IsLocked($faqtoid) == 1); + + ### + ### lets go do some checking. + ### + + # factoidPreventForgetLimitTime: + if (!($isop or $isau) and $age/(60*60*24) > $limitage) { + &msg($who, "cannot remove factoid '$faqtoid', too old. (" . + $age/(60*60*24) . ">$limitage) use 'no,' instead"); + return; + } + + # factoidPreventForgetLimit: + if (!($isop or $isau) and $limit and $count > $limit) { + &msg($who, "will not delete '$faqtoid', count > limit ($count > $limit) use 'no, ' instead."); + return; + } + + # this may eat some memory. + # prevent deletion if other factoids redirect to it. + # TODO: use hash instead of array. + my @list; + if (&getChanConf('factoidPreventForgetRedirect')) { + &status("Factoids/Core: forget: checking for redirect factoids"); + @list = &searchTable('factoids', 'factoid_key', + 'factoid_value', "^ see "); + } + + my $match = 0; + for (@list) { + my $f = $_; + my $v = &getFactInfo($f, 'factoid_value'); + my $fsafe = quotemeta($faqtoid); + next unless ($v =~ /^ ?see( also)? $fsafe\.?$/i); + + &DEBUG("Factoids/Core: match! ($f || $faqtoid)"); + + $match++; + } + # TODO: warn for op aswell, but allow force delete. + if (!$isop and $match) { + &msg($who, "uhm, other (redirection) factoids depend on this one."); + return; + } + + # minimize abuse. + if (!$isop and &IsHostMatch($author) != 2) { + $cache{forget}{$h}++; + + # warn. + if ($cache{forget}{$h} > 3) { + &msg($who, "Stop abusing forget!"); + } + + # ignore. + # TODO: make forget limit configurable. + # TODO: make forget ignore time configurable. + if ($cache{forget}{$h} > 5) { + &ignoreAdd(&makeHostMask($nuh), '*', 3*24*60, "abuse of forget"); + &msg($who, "forget: Ignoring you for abuse!"); + } + } + + # lets do it! + + if (&IsParam('factoidDeleteDelay') or &IsChanConf('factoidDeleteDelay') > 0) { + if (!($isop or $isau) and $faqtoid =~ / #DEL#$/) { + &msg($who, "cannot delete it ($faqtoid)."); + return; + } + + &status("forgot (safe delete): '$faqtoid' - ". scalar(gmtime)); + ### TODO: check if the 'backup' exists and overwrite it + my $check = &getFactoid("$faqtoid #DEL#"); + + if (!defined $check or $check =~ /^\s*$/) { + if ($faqtoid !~ / #DEL#$/) { + my $new = $faqtoid." #DEL#"; + + my $backup = &getFactoid($new); + if ($backup) { + &DEBUG("forget: not overwriting backup: $faqtoid"); + } else { + &status("forget: backing up '$faqtoid'"); + &setFactInfo($faqtoid, 'factoid_key', $new); + &setFactInfo($new, 'modified_by', $who); + &setFactInfo($new, 'modified_time', time()); + } + + } else { + &status("forget: not backing up $faqtoid."); + } + + } else { + &status("forget: not overwriting backup!"); + } + } + + &status("forget: <$who> '$faqtoid' =is=> '$result'"); + &delFactoid($faqtoid); + + &performReply("i forgot $faqtoid"); + + $count{'Update'}++; + + return; + } + + # factoid unforget/undelete. + if ($message =~ s/^un(forget|delete)\s+//i) { + return 'unforget: no addr' unless ($addressed); + + my $i = 0; + $i++ if (&IsParam('factoidDeleteDelay')); + $i++ if (&IsChanConf('factoidDeleteDelay') > 0); + if (!$i) { + &performReply("safe delete has been disable so what is there to undelete?"); + return; + } + + my $faqtoid = $message; + if ($faqtoid eq '') { + &help('unforget'); + return; + } + + $faqtoid =~ tr/A-Z/a-z/; + my $result = &getFactoid($faqtoid." #DEL#"); + my $check = &getFactoid($faqtoid); + + if (defined $check) { + &performReply("cannot undeleted '$faqtoid' because it already exists!"); + return; + } + + if (!defined $result) { + &performReply("that factoid was not backedup :/"); + return; + } + + &setFactInfo($faqtoid." #DEL#", 'factoid_key', $faqtoid); +# &setFactInfo($faqtoid, 'modified_by', ''); +# &setFactInfo($faqtoid, 'modified_time', 0); + + $check = &getFactoid($faqtoid); + # TODO: check if $faqtoid." #DEL#" exists? + if (defined $check) { + &performReply("Successfully recovered '$faqtoid'. Have fun now."); + $count{'Undelete'}++; + } else { + &performReply("did not recover '$faqtoid'. What happened?"); + } + + return; + } + + # factoid locking. + if ($message =~ /^((un)?lock)(\s+(.*))?\s*?$/i) { + return 'lock: no addr 2' unless ($addressed); + + my $function = lc $1; + my $faqtoid = lc $4; + + if ($faqtoid eq '') { + &help($function); + return; + } + + if (&getFactoid($faqtoid) eq '') { + &msg($who, "factoid \002$faqtoid\002 does not exist"); + return; + } + + if ($function eq 'lock') { + # strongly requested by #debian on 19991028. -xk + if (1 and $faqtoid !~ /^\Q$who\E$/i and &IsFlag('o') ne 'o') { + &msg($who,"sorry, locking cannot be used since it can be abused unneccesarily."); + &status("Replace 1 with 0 in Process.pl#~324 for locking support."); + return; + } + + &CmdLock($faqtoid); + } else { + &CmdUnLock($faqtoid); + } + + return; + } + + # factoid rename. + if ($message =~ s/^rename(\s+|$)//) { + return 'rename: no addr' unless ($addressed); + + if ($message eq '') { + &help('rename'); + return; + } + + if ($message =~ /^'(.*)'\s+'(.*)'$/) { + my ($from,$to) = (lc $1, lc $2); + + my $result = &getFactoid($from); + if (!defined $result) { + &performReply("i didn't have anything called '$from' to rename"); + return; + } + + # who == nick!user@host. + if (&IsFlag('m') ne 'm' and $author !~ /^\Q$who\E\!/i) { + &msg($who, "factoid '$from' is not yours to modify."); + return; + } + + if ($_ = &getFactoid($to)) { + &performReply("destination factoid already exists."); + return; + } + + &setFactInfo($from,'factoid_key',$to); + + &status("rename: <$who> '$from' is now '$to'"); + &performReply("i renamed '$from' to '$to'"); + } else { + &msg($who,"error: wrong format. ask me about 'help rename'."); + } + + return; + } + + # factoid substitution. (X =~ s/A/B/FLAG) + if ($message =~ m|^(.*?)\s+=~\s+s([/,#])(.+?)\2(.*?)\2([a-z]*);?\s*$|) { + my ($faqtoid,$delim,$op,$np,$flags) = (lc $1, $2, $3, $4, $5); + return 'subst: no addr' unless ($addressed); + + # incorrect format. + if ($np =~ /$delim/) { + &msg($who,"looks like you used the delimiter too many times. You may want to use a different delimiter, like ':' or '#'."); + return; + } + + # success. + if (my $result = &getFactoid($faqtoid)) { + return 'subst: locked' if (&IsLocked($faqtoid) == 1); + my $was = $result; + + if (($flags eq 'g' && $result =~ s/\Q$op/$np/gi) || $result =~ s/\Q$op/$np/i) { + # excessive length. + if (length $result > $param{'maxDataSize'}) { + &performReply("that's too long"); + return; + } + # empty + if (length $result == 0) { + &performReply("factoid would be empty. use forget?"); + return; + } + # min length. + my $faqauth = &getFactInfo($faqtoid, 'created_by'); + if ((length $result)*2 < length $was and + &IsFlag('o') ne 'o' and + &IsHostMatch($faqauth) != 2 + ) { + &performReply("too drastic change of factoid."); + } + + &setFactInfo($faqtoid, 'factoid_value', $result); + &status("update: '$faqtoid' =is=> '$result'; was '$was'"); + &performReply('OK'); + } else { + &performReply("that doesn't contain '$op'"); + } + } else { + &performReply("i didn't have anything called '$faqtoid' to modify"); + } + + return; + } + + # Fix up $message for question. + my $question = $message; + for ($question) { + # fix the string. + s/^hey([, ]+)where/where/i; + s/\s+\?$/?/; + s/^whois /who is /i; # Must match ^, else factoids with "whois" anywhere break + s/where can i find/where is/i; + s/how about/where is/i; + s/ da / the /ig; + + # clear the string of useless words. + s/^(stupid )?q(uestion)?:\s+//i; + s/^(does )?(any|ne)(1|one|body) know //i; + + s/^[uh]+m*[,\.]* +//i; + + s/^well([, ]+)//i; + s/^still([, ]+)//i; + s/^(gee|boy|golly|gosh)([, ]+)//i; + s/^(well|and|but|or|yes)([, ]+)//i; + + s/^o+[hk]+(a+y+)?([,. ]+)//i; + s/^g(eez|osh|olly)([,. ]+)//i; + s/^w(ow|hee|o+ho+)([,. ]+)//i; + s/^heya?,?( folks)?([,. ]+)//i; + } + + if ($addressed and $message =~ s/^no([, ]+)(\Q$ident\E\,+)?\s*//i) { + $correction_plausible = 1; + &status("correction is plausible, initial negative and nick deleted ($&)") if ($param{VERBOSITY}); + } else { + $correction_plausible = 0; + } + + my $result = &doQuestion($question); + if (!defined $result or $result eq $noreply) { + return 'result from doQ undef.'; + } + + if (defined $result and $result !~ /^0?$/) { # question. + &status("question: <$who> $message"); + $count{'Question'}++; + } elsif (&IsChanConf('Math') > 0 and $addressed) { # perl math. + &loadMyModule('Math'); + my $newresult = &perlMath(); + + if (defined $newresult and $newresult ne '') { + $cmdstats{'Maths'}++; + $result = $newresult; + &status("math: <$who> $message => $result"); + } + } + + if ($result !~ /^0?$/) { + &performStrictReply($result); + return; + } + + # why would a friendly bot get passed here? + if (&IsParam('friendlyBots')) { + return if (grep lc($_) eq lc($who), split(/\s+/, $param{'friendlyBots'})); + } + + # do the statement. + if (!defined &doStatement($message)) { + return; + } + + return unless ($addressed and !$addrchar); + + if (length $message > 64) { + &status("unparseable-moron: $message"); +# &performReply( &getRandom(keys %{ $lang{'moron'} }) ); + $count{'Moron'}++; + + &performReply("You are moron \002#". $count{'Moron'} ."\002"); + return; + } + + &status("unparseable: $message"); + &performReply( &getRandom(keys %{ $lang{'dunno'} }) ); + $count{'Dunno'}++; +} + +1; diff --git a/src/Factoids/DBCommon.pl b/src/Factoids/DBCommon.pl new file mode 100644 index 0000000..1d7c499 --- /dev/null +++ b/src/Factoids/DBCommon.pl @@ -0,0 +1,151 @@ +# +# DBStubs.pl: DB independent (I hope, heh) factoid support +# Author: dms +# Version: v0.6d (20000223) +# Created: 19991020 +# + +# use strict; # TODO + +##### +# Usage: &setFactInfo($faqtoid, $key, $val); +sub setFactInfo { + &sqlSet('factoids', + { factoid_key => $_[0] }, + { $_[1] => $_[2] } + ); +} + +##### +# Usage: &getFactInfo($faqtoid, [$what]); +sub getFactInfo { + return &sqlSelect('factoids', $_[1], { factoid_key => $_[0] } ); +} + +##### +# Usage: &getFactoid($faqtoid); +sub getFactoid { + return &getFactInfo($_[0], 'factoid_value'); +} + +##### +# Usage: &delFactoid($faqtoid); +sub delFactoid { + my ($faqtoid) = @_; + + &sqlDelete('factoids', { factoid_key => $faqtoid } ); + &status("DELETED $faqtoid"); + + return 1; +} + +##### +# Usage: &IsLocked($faqtoid); +sub IsLocked { + my ($faqtoid) = @_; + my $thisnuh = &getFactInfo($faqtoid, 'locked_by'); + + if (defined $thisnuh and $thisnuh ne '') { + if (!&IsHostMatch($thisnuh) and &IsFlag('o') ne 'o') { + &performReply("cannot alter locked factoids"); + return 1; + } + } + + return 0; +} + +##### +# Usage: &AddModified($faqtoid,$nuh); +sub AddModified { + my ($faqtoid,$nuh) = @_; + my $modified_by = &getFactInfo($faqtoid, 'modified_by'); + my (@modifiedlist, @modified, %modified); + + if (defined $modified_by) { + push(@modifiedlist, split(/\,/, $modified_by)); + } + push(@modifiedlist,$nuh); + + foreach (reverse @modifiedlist) { + /^(\S+)!(\S+)@(\S+)$/; + my $nick = lc $1; + next if (exists $modified{$nick}); + + $modified{$nick} = $_; + push(@modified,$nick); + } + + undef @modifiedlist; + + foreach (reverse @modified) { + push(@modifiedlist, $modified{$_}); + } + shift(@modifiedlist) while (scalar @modifiedlist > 3); + + &setFactInfo($faqtoid, 'modified_by', join(",",@modifiedlist)); + &setFactInfo($faqtoid, 'modified_time', time()); + + return 1; +} + +##### +### Commands which use the fundamental functions... Helpers? +##### + +##### +# Usage: &CmdLock($function,$faqtoid); +sub CmdLock { + my ($faqtoid) = @_; + + my $thisnuh = &getFactInfo($faqtoid,'locked_by'); + + if (defined $thisnuh and $thisnuh ne '') { + my $locked_by = (split(/\!/,$thisnuh))[0]; + &msg($who,"factoid \002$faqtoid\002 has already been locked by $locked_by."); + return 0; + } + + $thisnuh ||= &getFactInfo($faqtoid,'created_by'); + + # fixes bug found on 19991103. + # code needs to be reorganised though. + if ($thisnuh ne '') { + if (!&IsHostMatch($thisnuh) && IsFlag('o') ne 'o') { + &msg($who, "sorry, you are not allowed to lock '$faqtoid'."); + return 0; + } + } + + &performReply("locking factoid \002$faqtoid\002"); + &setFactInfo($faqtoid,'locked_by',$nuh); + &setFactInfo($faqtoid,'locked_time', time()); + + return 1; +} + +##### +# Usage: &CmdUnLock($faqtoid); +sub CmdUnLock { + my ($faqtoid) = @_; + + my $thisnuh = &getFactInfo($faqtoid,'locked_by'); + + if (!defined $thisnuh) { + &msg($who, "factoid \002$faqtoid\002 is not locked."); + return 0; + } + + if ($thisnuh ne '' and !&IsHostMatch($thisnuh) and &IsFlag('o') ne 'o') { + &msg($who, "sorry, you are not allowed to unlock factoid '$faqtoid'."); + return 0; + } + + &performReply("unlocking factoid \002$faqtoid\002"); + &setFactInfo($faqtoid,'locked_by', ''); + &setFactInfo($faqtoid,'locked_time', '0'); # pgsql complains if NOT NULL set. So set 0 which is the default + + return 1; +} + +1; diff --git a/src/Factoids/Norm.pl b/src/Factoids/Norm.pl new file mode 100644 index 0000000..980936c --- /dev/null +++ b/src/Factoids/Norm.pl @@ -0,0 +1,103 @@ +# +# Norm.pl: Norm. +# Author: Kevin Lenzo +# Version: 1997 +# + +# TODO: +# use strict; + +sub normquery { + my ($in) = @_; + + $in = " $in "; + + for ($in) { + # where blah is -> where is blah + s/ (where|what|who)\s+(\S+)\s+(is|are) / $1 $3 $2 /i; + + # where blah is -> where is blah + s/ (where|what|who)\s+(.*)\s+(is|are) / $1 $3 $2 /i; + + s/^\s*(.*?)\s*/$1/; + + s/be tellin\'?g?/tell/i; + s/ \'?bout/ about/i; + + s/,? any(hoo?w?|ways?)/ /ig; + s/,?\s*(pretty )*please\??\s*$/\?/i; + + # what country is ... + if ($in =~ + s/wh(at|ich)\s+(add?res?s|country|place|net (suffix|domain))/wh$1 /ig) { + if ((length($in) == 2) && ($in !~ /^\./)) { + $in = '.'.$in; + } + $in .= '?'; + } + + # profanity filters. just delete it + s/th(e|at|is) (((m(o|u)th(a|er) ?)?fuck(in\'?g?)?|hell|heck|(god-?)?damn?(ed)?) ?)+//ig; + s/wtf/where/gi; + s/this (.*) thingy?/ $1/gi; + s/this thingy? (called )?//gi; + s/ha(s|ve) (an?y?|some|ne) (idea|clue|guess|seen) /know /ig; + s/does (any|ne|some) ?(1|one|body) know //ig; + s/do you know //ig; + s/can (you|u|((any|ne|some) ?(1|one|body)))( please)? tell (me|us|him|her)//ig; + s/where (\S+) can \S+ (a|an|the)?//ig; + s/(can|do) (i|you|one|we|he|she) (find|get)( this)?/is/i; # where can i find + s/(i|one|we|he|she) can (find|get)/is/gi; # where i can find + s/(the )?(address|url) (for|to) //i; # this should be more specific + s/(where is )+/where is /ig; + s/\s+/ /g; + s/^\s+//; + if ($in =~ s/\s*[\/?!]*\?+\s*$//) { + $finalQMark = 1; + } + + s/\s+/ /g; + s/^\s*(.*?)\s*$/$1/; + s/^\s+|\s+$//g; # why twice, see Question.pl + } + + return $in; +} + +# for be-verbs +sub switchPerson { + my ($in) = @_; + + for ($in) { + # # fix genitives + s/(^|\W)\Q$who\Es\s+/$1${who}\'s /ig; + s/(^|\W)\Q$who\Es$/$1${who}\'s/ig; + s/(^|\W)\Q$who\E\'(\s|$)/$1${who}\'s$2/ig; + + s/(^|\s)i\'m(\W|$)/$1$who is$2/ig; + s/(^|\s)i\'ve(\W|$)/$1$who has$2/ig; + s/(^|\s)i have(\W|$)/$1$who has$2/ig; + s/(^|\s)i haven\'?t(\W|$)/$1$who has not$2/ig; + s/(^|\s)i(\W|$)/$1$who$2/ig; + s/ am\b/ is/i; + s/\bam /is/i; + s/(^|\s)(me|myself)(\W|$)/$1$who$3/ig; + s/(^|\s)my(\W|$)/$1${who}\'s$2/ig; # turn 'my' into name's + s/(^|\W)you\'?re(\W|$)/$1you are$2/ig; + + if ($addressed) { + my $mynick = 'UNDEF'; + $mynick = $conn->nick() if ($conn); + # is it safe to remove $in from here, too? + $in =~ s/yourself/$mynick/i; + $in =~ s/(^|\W)are you(\W|$)/$1is $mynick$2/ig; + $in =~ s/(^|\W)you are(\W|$)/$1$mynick is$2/ig; + $in =~ s/(^|\W)you(\W|$)/$1$mynick$2/ig; + $in =~ s/(^|\W)your(\W|$)/$1$mynick\'s$2/ig; + } + } + + return $in; +} + +1; diff --git a/src/Factoids/Question.pl b/src/Factoids/Question.pl new file mode 100644 index 0000000..1ba3b55 --- /dev/null +++ b/src/Factoids/Question.pl @@ -0,0 +1,303 @@ +### +### Question.pl: Kevin Lenzo (c) 1997 +### + +## doQuestion -- +## if ($query == query) { +## return $value; +## } else { +## return NULL; +## } +## +## + +# use strict; # TODO + +use vars qw($query $reply $finalQMark $nuh $result $talkok $who $nuh); +use vars qw(%bots %forked); + +sub doQuestion { + # my doesn't allow variables to be inherinted, local does. + # following is used in math()... + local($query) = @_; + local($reply) = ''; + local $finalQMark = $query =~ s/\?+\s*$//; + $finalQMark += $query =~ s/\?\s*$//; + $query =~ s/^\s+|\s+$//g; + + if (!defined $query or $query =~ /^\s*$/) { + return ''; + } + + my $questionWord = ''; + + if (!$addressed) { + return '' unless ($finalQMark); + return '' unless &IsChanConf('minVolunteerLength') > 0; + return '' if (length $query < &::getChanConf('minVolunteerLength')); + } else { + ### TODO: this should be caught in Process.pl? + return '' unless ($talkok); + + # there is no flag to disable/enable asking factoids... + # so it was added... thanks zyxep! :) + if (&IsFlag('a') ne 'a' && &IsFlag('o') ne 'o') { + &status("$who tried to ask us when not allowed."); + return; + } + } + + # dangerous; common preambles should be stripped before here + if ($query =~ /^forget /i or $query =~ /^no, /) { + return if (exists $bots{$nuh}); + } + + if ($query =~ s/^literal\s+//i) { + &status("literal ask of '$query'."); + $literal = 1; + } + + # convert to canonical reference form + my $x; + my @query; + + push(@query, $query); # 1: push original. + + # valid factoid. + if ($query =~ s/[!.]$//) { + push(@query, $query); + } + + $x = &normquery($query); + push(@query, $x) if ($x ne $query); + $query = $x; + + $x = &switchPerson($query); + push(@query, $x) if ($x ne $query); + $query = $x; + + $query =~ s/\s+at\s*(\?*)$/$1/; # where is x at? + $query =~ s/^explain\s*(\?*)/$1/i; # explain x + $query = " $query "; # side whitespaces. + + my $qregex = join '|', keys %{ $lang{'qWord'} }; + + # purge prefix question string. + if ($query =~ s/^ ($qregex)//i) { + $questionWord = lc($1); + } + + if ($questionWord eq '' and $finalQMark and $addressed) { + $questionWord = 'where'; + } + $query =~ s/^\s+|\s+$//g; # bleh. hacked. + push(@query, $query) if ($query ne $x); + + if (&IsChanConf('factoidArguments') > 0) { + $result = &factoidArgs($query[0]); + + return $result if (defined $result); + } + + my @link; + for (my$i=0; $i= 5) { + &status("recursive link limit (5) reached."); + last; + } + + push(@link, $link); + my $newr = &getReply($link); + + # no such factoid. try commands + if (!defined $newr || $newr =~ /^0?$/) { + # support command redirection. + # recursive cmdHooks aswell :) + my $done = 0; + $done++ if &parseCmdHook($link); + $message = $link; + $done++ unless (&Modules()); + + return; + } + last if (!defined $newr or $newr eq ''); + $result = $newr; + } + + if (@link) { + &status("'$query' linked to: ".join(" => ", @link) ); + } + + if ($i != 0) { + &VERB("Question.pl: '$query[0]' did not exist; '$query[$i]' ($i) did",2); + } + + return $result; + } + + ### TODO: Use &Forker(); move function to Debian.pl + if (&IsChanConf('debianForFactoid') > 0) { + &loadMyModule('Debian'); + $result = &Debian::DebianFind($query); # ??? + ### TODO: debian module should tell, through shm, that it went + ### ok or not. +### return $result if (defined $result); + } + + if ($questionWord ne '' or $finalQMark) { + # if it has not been explicitly marked as a question + if ($addressed and $reply eq '') { + &status("notfound: <$who> ".join(' :: ', @query)) + if ($finalQMark); + + return '' unless (&IsParam('friendlyBots')); + + foreach (split /\s+/, $param{'friendlyBots'}) { + &msg($_, ":INFOBOT:QUERY <$who> $query"); + } + } + } + + return $reply; +} + +sub factoidArgs { + my($str) = @_; + my $result; + + # to make it eleeter, split each arg and use "blah OR blah or BLAH" + # which will make it less than linear => quicker! + # TODO: cache this, update cache when altered. !!! !!! !!! +# my $t = &timeget(); + my ($first) = split(/\s+/, $str); + + # ignore split to commands [dumb commands vs. factoids] (editing commands?) + return undef if $str =~ /\s+\=\~\s+s[\#\/\:]/; + my @list = &searchTable('factoids', 'factoid_key', 'factoid_key', "^cmd: $first "); +# my $delta_time = &timedelta($t); +# &DEBUG("factArgs: delta_time = $delta_time s"); +# &DEBUG("factArgs: list => ".scalar(@list) ); + + # from a design perspective, it's better to have the regex in + # the factoid key to reduce repetitive processing. + + # it does not matter if it's not alphabetically sorted. + foreach (sort { length($b) <=> length($a) } @list) { + next if (/#DEL#/); # deleted. + + s/^cmd: //i; +# &DEBUG("factarg: '$str' =~ /^$_\$/"); + my $arg = $_; + + # eval (evil!) code. cleaned up courtesy of lear. + my @vals; + eval { + @vals = ($str =~ /^$arg$/i); + }; + + if ($@) { + &WARN("factargs: regex failed! '$str' =~ /^$_\$/"); + next; + } + + next unless (@vals); + + if (defined $result) { + &WARN("factargs: '$_' matches aswell."); + next; + } + +# &DEBUG("vals => @vals"); + + &status("Question: factoid Arguments for '$str'"); + # TODO: use getReply() - need to modify it :( + my $i = 0; + my $q = "cmd: $_"; + my $r = &getFactoid($q); + if (!defined $r) { + &DEBUG("question: !result... should this happen?"); + return; + } + + # update stats. old mysql/sqlite don't do +1 + my ($count) = &sqlSelect('factoids', 'requested_count', { factoid_key => $q }); + $count++; + &sqlSet('factoids', {'factoid_key' => $q}, { + requested_by => $nuh, + requested_time => time(), + requested_count => $count + } ); + + # end of update stats. + + $result = $r; + + $result =~ s/^\((.*?)\): //; + my $vars = $1; + + # start nasty hack to get partial &getReply() functionality. + $result = &SARit($result); + + foreach ( split(',', $vars) ) { + my $val = $vals[$i]; +# &DEBUG("val => $val"); + + if (!defined $val) { + &status("factArgs: vals[$i] == undef; not SARing '$_' for '$str'"); + next; + } + + my $done = 0; + my $old = $result; + while (1) { +# &DEBUG("Q: result => $result (1before)"); + $result = &substVars($result,1); +# &DEBUG("Q: result => $result (1after)"); + + last if ($old eq $result); + $old = $result; + $done++; + } + + # hack. + $vals[$i] =~ s/^me$/$who/gi; + +# if (!$done) { + &status("factArgs: SARing '$_' to '$vals[$i]'."); + $result =~ s/\Q$_\E/$vals[$i]/g; +# } + $i++; + } + + # rest of nasty hack to get partial &getReply() functionality. + $result =~ s/^\s*\s*(.*)/\cAACTION $1\cA/i; + $result =~ s/^\s*\s*//i; + +# well... lets go through all of them. not advisable if we have like +# 1000 commands, heh. +# return $result; + $cmdstats{'Factoid Commands'}++; + } + + return $result; +} + +1; diff --git a/src/Factoids/Reply.pl b/src/Factoids/Reply.pl new file mode 100644 index 0000000..1ab437a --- /dev/null +++ b/src/Factoids/Reply.pl @@ -0,0 +1,367 @@ +### +### Reply.pl: Kevin Lenzo (c) 1997 +### + +## +# x is y === $lhs $mhs $rhs +# +# lhs - factoid. +# mhs - verb. +# rhs - factoid message. +## + +# use strict; # TODO +use POSIX qw(strftime); + +use vars qw($msgType $uh $lastWho $ident); +use vars qw(%lang %lastWho); + +sub getReply { + my($message) = @_; + my($lhs,$mhs,$rhs); + my($reply, $count, $fauthor, $result, $factoid, $search, @searches); + $orig{message} = $message; + + if (!defined $message or $message =~ /^\s*$/) { + &WARN("getR: message == NULL."); + return ''; + } + + $message =~ tr/A-Z/a-z/; + + @searches = split(/\s+/, &getChanConfDefault('factoidSearch', '_default', $chan)); + &::DEBUG("factoidSearch: $chan is: " . join(':', @searches)); + # requesting the _default one, ignore factoidSearch + if ($message =~ /^_default\s+/) { + @searches = ('_default'); + $message =~ s/^_default\s+//; + } + + # check for factoids with each prefix + foreach $search (@searches) { + if ($search eq '$chan') { + $factoid = "$chan $message"; + } elsif ($search eq '_default') { + $factoid = $message; + } else { + $factoid = "$search $message"; + } + ($count, $fauthor, $result) = &sqlSelect('factoids', + "requested_count,created_by,factoid_value", + { factoid_key => $factoid } + ); + last if ($result); + } + + if ($result) { + $lhs = $message; + $mhs = 'is'; + $rhs = $result; + + return "\"$factoid\" $mhs \"$rhs\"" if ($literal); + } else { + return ''; + } + + # if there was a head... + my(@poss) = split '\|\|', $result; + $poss[0] =~ s/^\s//; + $poss[$#poss] =~ s/\s$//; + + if (@poss > 1) { + $result = &getRandom(@poss); + $result =~ s/^\s*//; + } + + $result = &SARit($result); + + $reply = $result; + if ($result ne '') { + ### AT LAST, REPEAT PREVENTION CODE REMOVED IN FAVOUR OF GLOBAL + ### FLOOD REPETION AND PROTECTION. -20000124 + + # stats code. + ### FIXME: old mysql/sqlite doesn't support + ### "requested_count=requested_count+1". + $count++; + &sqlSet('factoids', {'factoid_key' => $factoid}, { + requested_by => $nuh, + requested_time => time(), + requested_count => $count + } ); + + # TODO: rename $real to something else! + my $real = 0; +# my $author = &getFactInfo($lhs,'created_by') || ''; +# $real++ if ($author =~ /^\Q$who\E\!/); +# $real++ if (&IsFlag('n')); + $real = 0 if ($msgType =~ /public/); + + ### fix up the reply. + # only remove '' + if (!$real and $reply =~ s/^\s*\s*//i) { + # 'are' fix. + if ($reply =~ s/^are /$lhs are /i) { + &VERB("Reply.pl: el-cheapo 'are' fix executed.",2); + } + + } elsif (!$real and $reply =~ s/^\s*\s*(.*)/\cAACTION $1\cA/i) { + # only remove '' and make it an action. + } else { # not a short reply + + ### bot->bot reply. + if (exists $bots{$nuh} and $rhs !~ /^\s*$/) { + return "$lhs $mhs $rhs"; + } + + ### bot->person reply. + # result is random if separated by '||'. + # rhs is full factoid with '||'. + if ($mhs eq 'is') { + $reply = &getRandom(keys %{ $lang{'factoid'} }); + $reply =~ s/##KEY/$lhs/; + $reply =~ s/##VALUE/$result/; + } else { + $reply = "$lhs $mhs $result"; + } + + if ($reply =~ s/^\Q$who\E is/you are/i) { + # fix the person. + } else { + if ($reply =~ /^you are / or $reply =~ / you are /) { + return if ($addressed); + } + } + } + } + + # remove excessive beginning and end whitespaces. + $reply =~ s/^\s+|\s+$//g; + + if ($reply =~ /^\s+$/) { + &DEBUG("Reply: Null factoid ($message)"); + return ''; + } + + return $reply unless ($reply =~ /\$/); + + ### + ### $ SUBSTITUTION. + ### + + # don't evaluate if it has factoid arguments. +# if ($message =~ /^cmd:/i) { +# &status("Reply: not doing substVars (eval dollar vars)"); +# } else { + $reply = &substVars($reply,1); +# } + + $reply; +} + +sub smart_replace { + my ($string) = @_; + my ($l,$r) = (0,0); # l = left, r = right. + my ($s,$t) = (0,0); # s = start, t = marker. + my $i = 0; + my $old = $string; + my @rand; + + foreach (split //, $string) { + + if ($_ eq "(") { + if (!$l and !$r) { + $s = $i; + $t = $i; + } + + $l++; + $r--; + } + + if ($_ eq ")") { + $r++; + $l--; + + if (!$l and !$r) { + my $substr = substr($old,$s,$i-$s+1); + push(@rand, substr($old,$t+1,$i-$t-1) ); + + my $rand = $rand[rand @rand]; +# &status("SARing '$substr' to '$rand'."); + $string =~ s/\Q$substr\E/$rand/; + undef @rand; + } + } + + if ($_ eq "|" and $l+$r== 0 and $l==1) { + push(@rand, substr($old,$t+1,$i-$t-1) ); + $t = $i; + } + + $i++; + } + + if ($old eq $string) { + &WARN("smart_replace: no subst made. (string => $string)"); + } + + return $string; +} + +sub SARit { + my($txt) = @_; + my $done = 0; + + # (blah1|blah2)? + while ($txt =~ /\((.*?)\)\?/) { + my $str = $1; + if (rand() > 0.5) { # fix. + &status("Factoid transform: keeping '$str'."); + $txt =~ s/\(\Q$str\E\)\?/$str/; + } else { # remove + &status("Factoid transform: removing '$str'."); + $txt =~ s/\(\Q$str\E\)\?\s?//; + } + $done++; + last if ($done >= 10); # just in case. + } + $done = 0; + + # EG: (0-32768) => 6325 + ### TODO: (1-10,20-30,40) => 24 + while ($txt =~ /\((\d+)-(\d+)\)/) { + my ($lower,$upper) = ($1,$2); + my $new = int(rand $upper-$lower) + $lower; + + &status("SARing '$&' to '$new' (2)."); + $txt =~ s/$&/$new/; + $done++; + last if ($done >= 10); # just in case. + } + $done = 0; + + # EG: (blah1|blah2|blah3|) => blah1 + while ($txt =~ /.*\((.*\|.*?)\).*/) { + $txt = &smart_replace($txt); + + $done++; + last if ($done >= 10); # just in case. + } + &status("Reply.pl: $done SARs done.") if ($done); + + # type + # + while ($txt =~ /(.*)<\/URL>/){ + &status("we have to norm this stuff, SARing"); + my $foobar = $1; + if ($foobar =~ m/(http:\/\/[^?]+)\?(.*)/){ + my ($pig1,$pig2) = ($1,$2); + &status("SARing using URLencode"); + $pig2=~s/([^\w])/sprintf("%%%02x",ord($1))/gie; + $foobar=$pig1."?".$pig2; + } + $txt =~ s/(.*)<\/URL>/$foobar/; + } + return $txt; +} + +sub substVars { + my($reply,$flag) = @_; + + # $date, $time, $day. + # TODO: support localtime. + my $date = strftime("%Y.%m.%d", gmtime()); + $reply =~ s/\$date/$date/gi; + my $time = strftime("%k:%M:%S", gmtime()); + $reply =~ s/\$time/$time/gi; + my $day = strftime("%A", gmtime()); + $reply =~ s/\$day/$day/gi; + + # support $ident when I have multiple nicks + my $mynick = $conn->nick() if $conn; + + # dollar variables. + if ($flag) { + $reply =~ s/\$nick/$who/g; + $reply =~ s/\$who/$who/g; # backward compat. + } + + if ($reply =~ /\$(user(name)?|host)/) { + my ($username, $hostname) = split /\@/, $uh; + $reply =~ s/\$user(name)?/$username/g; + $reply =~ s/\$host(name)?/$hostname/g; + } + $reply =~ s/\$chan(nel)?/$talkchannel/g; + if ($msgType =~ /public/) { + $reply =~ s/\$lastspeaker/$lastWho{$talkchannel}/g; + } else { + $reply =~ s/\$lastspeaker/$lastWho/g; + } + + if ($reply =~ /\$rand/) { + my $rand = rand(); + + # $randnick. + if ($reply =~ /\$randnick/) { + my @nicks = keys %{ $channels{$chan}{''} }; + my $randnick = $nicks[ int($rand*$#nicks) ]; + $reply =~ s/\$randnick/$randnick/g; + } + + # eg: $rand100.3 + if ($reply =~ /\$rand(\d+)(\.(\d+))?/) { + my $max = $1; + my $dot = $3 || 0; + my $orig = $&; + #&DEBUG("dot => $dot, max => $max, rand=>$rand"); + $rand = sprintf("%.*f", $dot, $rand*$max); + + &DEBUG("swapping $orig to $rand"); + $reply =~ s/\Q$orig\E/$rand/eg; + } else { + $reply =~ s/\$rand/$rand/g; + } + } + + $reply =~ s/\$ident/$mynick/g; + + if ($reply =~ /\$startTime/) { + my $time = scalar(gmtime $^T); + $reply =~ s/\$startTime/$time/; + } + + if ($reply =~ /\$uptime/) { + my $uptime = &Time2String(time() - $^T); + $reply =~ s/\$uptime/$uptime/; + } + + if ($reply =~ /\$factoids/) { + my $factoids = &countKeys('factoids'); + $reply =~ s/\$factoids/$factoids/; + } + + if ($reply =~ /\$Fupdate/) { + my $x = "\002$count{'Update'}\002 ". + &fixPlural('modification', $count{'Update'}); + $reply =~ s/\$Fupdate/$x/; + } + + if ($reply =~ /\$Fquestion/) { + my $x = "\002$count{'Question'}\002 ". + &fixPlural('question', $count{'Question'}); + $reply =~ s/\$Fquestion/$x/; + } + + if ($reply =~ /\$Fdunno/) { + my $x = "\002$count{'Dunno'}\002 ". + &fixPlural('dunno', $count{'Dunno'}); + $reply =~ s/\$Fdunno/$x/; + } + + $reply =~ s/\$memusage/$memusage/; + + return $reply; +} + +1; diff --git a/src/Factoids/Statement.pl b/src/Factoids/Statement.pl new file mode 100644 index 0000000..8eaa5e1 --- /dev/null +++ b/src/Factoids/Statement.pl @@ -0,0 +1,114 @@ +### +### Statement.pl: Kevin Lenzo (c) 1997 +### + +## +## doStatement -- +## +## decide if $in is a statement, and if so, +## - update the db +## - return feedback statement +## +## otherwise return +## - null for confused. +## + +# use strict; # TODO + +sub doStatement { + my($in) = @_; + + $in =~ s/\\(\S+)/\#$1\#/g; # fix the backslash. + $in =~ s/^no([, ]+)//i; # 'no, '. + + # check if we need to be addressed and if we are + return unless ($learnok); + + my($urlType) = ''; + + # prefix www with http:// and ftp with ftp:// + $in =~ s/ www\./ http:\/\/www\./ig; + $in =~ s/ ftp\./ ftp:\/\/ftp\./ig; + + $urlType = 'about' if ($in =~ /\babout:/i); + $urlType = 'afp' if ($in =~ /\bafp:/); + $urlType = 'file' if ($in =~ /\bfile:/); + $urlType = 'palace' if ($in =~ /\bpalace:/); + $urlType = 'phoneto' if ($in =~ /\bphone(to)?:/); + if ($in =~ /\b(news|http|ftp|gopher|telnet):\s*\/\/[\-\w]+(\.[\-\w]+)+/) { + $urlType = $1; + } + + # acceptUrl. + if (&IsParam('acceptUrl')) { + if ($param{'acceptUrl'} eq 'REQUIRE') { # require url type. + return if ($urlType eq ''); + } elsif ($param{'acceptUrl'} eq 'REJECT') { + &status("REJECTED URL entry") if (&IsParam('VERBOSITY')); + return unless ($urlType eq ''); + } else { + # OPTIONAL + } + } + + # learn statement. '$lhs is|are $rhs' + if ($in =~ /(^|\s)(is|are)(\s|$)/i) { + my($lhs, $mhs, $rhs) = ($`, $&, $'); + + # allows factoid arguments to be updated. -lear. + $lhs =~ s/^(cmd: )?(.*)/$1||'' . lc $2/e; + + # discard article. + $lhs =~ s/^(the|da|an?)\s+//i; + + # remove excessive initial and final whitespaces. + $lhs =~ s/^\s+|\s+$//g; + $mhs =~ s/^\s+|\s+$//g; + $rhs =~ s/^\s+|\s+$//g; + + # break if either lhs or rhs is NULL. + if ($lhs eq '' or $rhs eq '') { + return "NOT-A-STATEMENT"; + } + + # lets check if it failed. + if (&validFactoid($lhs,$rhs) == 0) { + if ($addressed) { + &status("IGNORE statement: <$who> $message"); + &performReply( &getRandom(keys %{ $lang{'confused'} }) ); + } + return; + } + + # uncomment to prevent HUNGRY learning of rhs with whitespace + #return if (!$addressed and $lhs =~ /\s+/); + &::DEBUG("doStatement: $in:$lhs:$mhs:$rhs"); + + &status("statement: <$who> $message"); + + # change "#*#" back to '*' because of '\' sar to '#blah#'. + $lhs =~ s/\#(\S+)\#/$1/g; + $rhs =~ s/\#(\S+)\#/$1/g; + + $lhs =~ s/\?+\s*$//; # strip off '?'. + + # verify the update statement whether there are any weird + # characters. + ### this can be simplified. + foreach (split //, $lhs.$rhs) { + my $ord = ord $_; + if ($ord > 170 and $ord < 220) { + &status("statement: illegal character '$_' $ord."); + &performAddressedReply("i'm not going to learn illegal characters"); + return; + } + } + + # success. + return if (&update($lhs, $mhs, $rhs)); + } + + return 'CONTINUE'; +} + +1; diff --git a/src/Factoids/Update.pl b/src/Factoids/Update.pl new file mode 100644 index 0000000..b948266 --- /dev/null +++ b/src/Factoids/Update.pl @@ -0,0 +1,228 @@ +# +# Update.pl: Add or modify factoids in the db. +# Author: Kevin Lenzo +# dms +# Version: 19991209 +# Created: 1997 +# + +# use strict; # TODO + +sub update { + my($lhs, $mhs, $rhs) = @_; + + for ($lhs) { + s/^i (heard|think) //i; + s/^some(one|1|body) said //i; + s/\s+/ /g; + } + + # locked. + return if (&IsLocked($lhs) == 1); + + # profanity. + if (&IsParam('profanityCheck') and &hasProfanity($rhs)) { + &performReply("please, watch your language."); + return 1; + } + + # teaching. + if (&IsFlag('t') ne 't' && &IsFlag('o') ne 'o') { + &msg($who, "permission denied."); + &status("alert: $who wanted to teach me."); + return 1; + } + + # invalid verb. + if ($mhs !~ /^(is|are)$/i) { + &ERROR("UNKNOWN verb: $mhs."); + return; + } + + # check if the arguments are too long to be stored in our table. + my $toolong = 0; + $toolong++ if (length $lhs > $param{'maxKeySize'}); + $toolong++ if (length $rhs > $param{'maxDataSize'}); + if ($toolong) { + &performAddressedReply("that's too long"); + return 1; + } + + # also checking. + my $also = ($rhs =~ s/^-?also //i); + my $also_or = ($also and $rhs =~ s/\s+(or|\|\|)\s+//); + + # factoid arguments handler. + # must start with a non-variable + if (&IsChanConf('factoidArguments') > 0 and $lhs =~ /^[^\$]+.*\$/) { + &status("Update: Factoid Arguments found."); + &status("Update: orig lhs => '$lhs'."); + &status("Update: orig rhs => '$rhs'."); + + my @list; + my $count = 0; + $lhs =~ s/^/cmd: /; + while ($lhs =~ s/\$(\S+)/(.*?)/) { + push(@list, "\$$1"); + $count++; + last if ($count >= 10); + } + + if ($count >= 10) { + &msg($who, "error: could not SAR properly."); + &DEBUG("error: lhs => '$lhs' rhs => '$rhs'."); + return; + } + + my $z = join(',',@list); + $rhs =~ s/^/($z): /; + + &status("Update: new lhs => '$lhs' rhs => '$rhs'."); + } + + # the fun begins. + my $exists = &getFactoid($lhs); + + if (!$exists) { + # nice 'are' hack (or work-around). + if ($mhs =~ /^are$/i and $rhs !~ /<\S+>/) { + &status("Update: 'are' hack detected."); + $mhs = 'is'; + $rhs = " are ". $rhs; + } + + &status("enter: <$who> \'$lhs\' =$mhs=> \'$rhs\'"); + $count{'Update'}++; + + &performAddressedReply('okay'); + + &sqlInsert('factoids', { + created_by => $nuh, + created_time => time(), # modified time. + factoid_key => $lhs, + factoid_value => $rhs, + } ); + + if (!defined $rhs or $rhs eq '') { + &ERROR("Update: rhs1 == NULL."); + } + + return 1; + } + + # factoid exists. + if ($exists eq $rhs) { + # this catches the following situation: (right or wrong?) + # "test is test" + # "test is also test" + &performAddressedReply("i already had it that way"); + return 1; + } + + if ($also) { # 'is also'. + if ($exists =~ /^ see /i) { + &TODO("Update.pl: append to linked factoid."); + } + + if ($also_or) { # 'is also ||'. + $rhs = $exists.' || '.$rhs; + } else { +# if ($exists =~ s/\,\s*$/, /) { + if ($exists =~ /\,\s*$/) { + &DEBUG("current has trailing comma, just append as is"); + &DEBUG("Up: exists => $exists"); + &DEBUG("Up: rhs => $rhs"); + # $rhs =~ s/^\s+//; + # $rhs = $exists." ".$rhs; # keep comma. + } + + if ($exists =~ /\.\s*$/) { + &DEBUG("current has trailing period, just append as is with 2 WS"); + &DEBUG("Up: exists => $exists"); + &DEBUG("Up: rhs => $rhs"); + # $rhs =~ s/^\s+//; + # use ucfirst();? + # $rhs = $exists." ".$rhs; # keep comma. + } + + if ($rhs =~ /^[A-Z]/) { + if ($rhs =~ /\w+\s*$/) { + &status("auto insert period to factoid."); + $rhs = $exists.". ".$rhs; + } else { # '?' or '.' assumed at end. + &status("orig factoid already had trailing symbol; not adding period."); + $rhs = $exists." ".$rhs; + } + } elsif ($exists =~ /[\,\.\-]\s*$/) { + &VERB("U: current has trailing symbols; inserting whitespace + new.",2); + $rhs = $exists." ".$rhs; + } elsif ($rhs =~ /^\./) { + &VERB("U: new text has ^.; appending directly",2); + $rhs = $exists.$rhs; + } else { + $rhs = $exists.', or '.$rhs; + } + } + + # max length check again. + if (length $rhs > $param{'maxDataSize'}) { + if (length $rhs > length $exists) { + &performAddressedReply("that's too long"); + return 1; + } else { + &status("Update: new length is still longer than maxDataSize but less than before, we'll let it go."); + } + } + + &performAddressedReply('okay'); + + $count{'Update'}++; + &status("update: <$who> \'$lhs\' =$mhs=> \'$rhs\'; was \'$exists\'"); + &sqlSet('factoids', {'factoid_key' => $lhs}, { + modified_by => $nuh, + modified_time => time(), + factoid_value => $rhs, + } ); + + if (!defined $rhs or $rhs eq '') { + &ERROR("Update: rhs1 == NULL."); + } + } else { # not 'also' + + if (!$correction_plausible) { # "no, blah is ..." + if ($addressed) { + &performStrictReply("...but \002$lhs\002 is already something else..."); + &status("FAILED update: <$who> \'$lhs\' =$mhs=> \'$rhs\'"); + } + return 1; + } + + my $author = &getFactInfo($lhs, 'created_by') || ''; + + if (IsFlag('m') ne 'm' && IsFlag('o') ne 'o' && + $author !~ /^\Q$who\E\!/i + ) { + &msg($who, "you can't change that factoid."); + return 1; + } + + &performAddressedReply('okay'); + + $count{'Update'}++; + &status("update: <$who> \'$lhs\' =$mhs=> \'$rhs\'; was \'$exists\'"); + + &sqlSet('factoids', {'factoid_key' => $lhs}, { + modified_by => $nuh, + modified_time => time(), + factoid_value => $rhs, + } ); + + if (!defined $rhs or $rhs eq '') { + &ERROR("Update: rhs1 == NULL."); + } + } + + return 1; +} + +1; diff --git a/src/Files.pl b/src/Files.pl new file mode 100644 index 0000000..080297f --- /dev/null +++ b/src/Files.pl @@ -0,0 +1,83 @@ +# +# Files.pl: Open and close, read and probably write files. +# Author: dms +# Version: v0.3 (20010120) +# Created: 19991221 +# + +use strict; + +use vars qw(%lang %ircPort); +use vars qw(@ircServers); +use vars qw($bot_config_dir); + +# File: Language support. +sub loadLang { + my ($file) = @_; + my $langCount = 0; + my $replyName; + + if (!open(FILE, $file)) { + &ERROR("Failed reading lang file ($file): $!"); + exit 0; + } + + undef %lang; # for rehash. + + while () { + chop; + if ($_ eq '' || /^#/) { + undef $replyName; + next; + } + + if (!/^\s/) { + $replyName = $_; + next; + } + + s/^[\s\t]+//g; + if (!$replyName) { + &status("loadLang: bad line ('$_')"); + next; + } + + $lang{$replyName}{$_} = 1; + $langCount++; + } + close FILE; + + $file =~ s/^.*\///; + &status("Loaded $file ($langCount items)"); +} + +# File: Irc Servers list. +sub loadIRCServers { + my ($file) = $bot_config_dir."/infobot.servers"; + @ircServers = (); + %ircPort = (); + + if (!open(FILE, $file)) { + &ERROR("Failed reading server list ($file): $!"); + exit 0; + } + + while () { + chop; + next if /^\s*$/; + next if /^[\#\[ ]/; + + if (/^(\S+)(:(\d+))?$/) { + push(@ircServers,$1); + $ircPort{$1} = ($3 || 6667); + } else { + &status("loadIRCServers: invalid line => '$_'."); + } + } + close FILE; + + $file =~ s/^.*\///; + &status("Loaded $file (". scalar(@ircServers) ." servers)"); +} + +1; diff --git a/src/IRC/Irc.pl b/src/IRC/Irc.pl new file mode 100644 index 0000000..5159832 --- /dev/null +++ b/src/IRC/Irc.pl @@ -0,0 +1,977 @@ +# +# Irc.pl: IRC core stuff. +# Author: dms +# Version: 20000126 +# NOTE: Based on code by Kevin Lenzo & Patrick Cole (c) 1997 +# + +use strict; + +no strict 'refs'; +no strict 'subs'; # IN/STDIN + +use vars qw(%floodjoin %nuh %dcc %cache %conns %channels %param %mask + %chanconf %orig %ircPort %ircstats %last %netsplit); +use vars qw($irc $nickserv $conn $msgType $who $talkchannel + $addressed $postprocess); +use vars qw($notcount $nottime $notsize $msgcount $msgtime $msgsize + $pubcount $pubtime $pubsize); +use vars qw($b_blue $ob); +use vars qw(@ircServers); + +#use open ':utf8'; +#use open ':std'; + +$nickserv = 0; +my $maxlinelen = 400; + +sub ircloop { + my $error = 0; + my $lastrun = 0; + +loop:; + while (my $host = shift @ircServers) { + # JUST IN CASE. irq was complaining about this. + if ($lastrun == time()) { + &DEBUG("ircloop: hrm... lastrun == time()"); + $error++; + sleep 10; + next; + } + + if (!defined $host) { + &DEBUG("ircloop: ircServers[x] = NULL."); + $lastrun = time(); + next; + } + next unless (exists $ircPort{$host}); + + my $retval = &irc($host, $ircPort{$host}); + next unless (defined $retval and $retval == 0); + $error++; + + if ($error % 3 == 0 and $error != 0) { + &status("IRC: Could not connect."); + &status("IRC: "); + next; + } + + if ($error >= 3*2) { + &status("IRC: cannot connect to any IRC servers; stopping."); + &shutdown(); + exit 1; + } + } + + &status("IRC: ok, done one cycle of IRC servers; trying again."); + + &loadIRCServers(); + goto loop; +} + +sub irc { + my ($server,$port) = @_; + + $irc = new Net::IRC; + + # TODO: move all this to an sql table + my $iaddr = inet_aton($server); + my $paddr = sockaddr_in($port, $iaddr); + my $proto = getprotobyname('tcp'); + + # why was this here? + #select STDOUT; + + # host->ip. + my $resolve; + if ($server =~ /\D$/) { + my $packed = scalar(gethostbyname($server)); + + if (!defined $packed) { + &status(" cannot resolve $server."); + return 0; + } + + $resolve = inet_ntoa($packed); + ### warning in Sys/Hostname line 78??? + ### caused inside Net::IRC? + } + + my %args = ( + Nick => $param{'ircNick'}, + Server => $server, + Port => $port, + Ircname => $param{'ircName'}, + ); + $args{'LocalAddr'} = $param{'ircHost'} if ($param{'ircHost'}); + $args{'Password'} = $param{'ircPasswd'} if ($param{'ircPasswd'}); + + foreach my $mynick (split ',', $param{'ircNick'}) { + &status("Connecting to port $port of server $server ($resolve) as $mynick ..."); + $args{'Nick'} = $mynick; + $conns{$mynick} = $irc->newconn(%args); + if (!defined $conns{$mynick}) { + &ERROR("IRC: connection failed."); + &ERROR("add \"set ircHost 0.0.0.0\" to your config. If that does not work"); + &ERROR("Please check /etc/hosts to see if you have a localhost line like:"); + &ERROR("127.0.0.1 localhost localhost"); + &ERROR("If this is still a problem, please contact the maintainer."); + } + $conns{$mynick}->maxlinelen($maxlinelen); + # handler stuff. + $conns{$mynick}->add_global_handler('caction', \&on_action); + $conns{$mynick}->add_global_handler('cdcc', \&on_dcc); + $conns{$mynick}->add_global_handler('cping', \&on_ping); + $conns{$mynick}->add_global_handler('crping', \&on_ping_reply); + $conns{$mynick}->add_global_handler('cversion', \&on_version); + $conns{$mynick}->add_global_handler('crversion', \&on_crversion); + $conns{$mynick}->add_global_handler('dcc_open', \&on_dcc_open); + $conns{$mynick}->add_global_handler('dcc_close', \&on_dcc_close); + $conns{$mynick}->add_global_handler('chat', \&on_chat); + $conns{$mynick}->add_global_handler('msg', \&on_msg); + $conns{$mynick}->add_global_handler('public', \&on_public); + $conns{$mynick}->add_global_handler('join', \&on_join); + $conns{$mynick}->add_global_handler('part', \&on_part); + $conns{$mynick}->add_global_handler('topic', \&on_topic); + $conns{$mynick}->add_global_handler('invite', \&on_invite); + $conns{$mynick}->add_global_handler('kick', \&on_kick); + $conns{$mynick}->add_global_handler('mode', \&on_mode); + $conns{$mynick}->add_global_handler('nick', \&on_nick); + $conns{$mynick}->add_global_handler('quit', \&on_quit); + $conns{$mynick}->add_global_handler('notice', \&on_notice); + $conns{$mynick}->add_global_handler('whoischannels', \&on_whoischannels); + $conns{$mynick}->add_global_handler('useronchannel', \&on_useronchannel); + $conns{$mynick}->add_global_handler('whois', \&on_whois); + $conns{$mynick}->add_global_handler('other', \&on_other); + $conns{$mynick}->add_global_handler('disconnect', \&on_disconnect); + $conns{$mynick}->add_global_handler([251,252,253,254,255], \&on_init); +# $conns{$mynick}->add_global_handler(302, \&on_init); # userhost + $conns{$mynick}->add_global_handler(303, \&on_ison); # notify. + $conns{$mynick}->add_global_handler(315, \&on_endofwho); + $conns{$mynick}->add_global_handler(422, \&on_endofwho); # nomotd. + $conns{$mynick}->add_global_handler(324, \&on_modeis); + $conns{$mynick}->add_global_handler(333, \&on_topicinfo); + $conns{$mynick}->add_global_handler(352, \&on_who); + $conns{$mynick}->add_global_handler(353, \&on_names); + $conns{$mynick}->add_global_handler(366, \&on_endofnames); + $conns{$mynick}->add_global_handler(376, \&on_endofmotd); # on_connect. + $conns{$mynick}->add_global_handler(433, \&on_nick_taken); + $conns{$mynick}->add_global_handler(439, \&on_targettoofast); + # for proper joinnextChan behaviour + $conns{$mynick}->add_global_handler(471, \&on_chanfull); + $conns{$mynick}->add_global_handler(473, \&on_inviteonly); + $conns{$mynick}->add_global_handler(474, \&on_banned); + $conns{$mynick}->add_global_handler(475, \&on_badchankey); + $conns{$mynick}->add_global_handler(443, \&on_useronchan); + # end of handler stuff. + } + + &clearIRCVars(); + + # change internal timeout value for scheduler. + $irc->{_timeout} = 10; # how about 60? + # Net::IRC debugging. + $irc->{_debug} = 1; + + $ircstats{'Server'} = "$server:$port"; + + # works? needs to actually do something + # should likely listen on a tcp port instead + #$irc->addfh(STDIN, \&on_stdin, 'r'); + + &status("starting main loop"); + + $irc->start; +} + +###################################################################### +######## IRC ALIASES IRC ALIASES IRC ALIASES IRC ALIASES ####### +###################################################################### + +sub rawout { + my ($buf) = @_; + $buf =~ s/\n//gi; + + # slow down a bit if traffic is 'high'. + # need to take into account time of last message sent. + if ($last{buflen} > 256 and length($buf) > 256) { + sleep 1; + } + + $conn->sl($buf) if (&whatInterface() =~ /IRC/); + + $last{buflen} = length($buf); +} + +sub say { + my ($msg) = @_; + my $mynick = $conn->nick(); + if (!defined $msg) { + $msg ||= 'NULL'; + &WARN("say: msg == $msg."); + return; + } + + if (&getChanConf('silent', $talkchannel)) { + &DEBUG("say: silent in $talkchannel, not saying $msg"); + return; + } + + if ( $postprocess ) { + undef $postprocess; + } elsif ($postprocess = &getChanConf('postprocess', $talkchannel)) { + &DEBUG("say: $postprocess $msg"); + &parseCmdHook($postprocess . ' ' . $msg); + undef $postprocess; + return; + } + + &status("<$mynick/$talkchannel> $msg"); + + return unless (&whatInterface() =~ /IRC/); + + $msg = 'zero' if ($msg =~ /^0+$/); + + my $t = time(); + + if ($t == $pubtime) { + $pubcount++; + $pubsize += length $msg; + + my $i = &getChanConfDefault('sendPublicLimitLines', 3, $chan); + my $j = &getChanConfDefault('sendPublicLimitBytes', 1000, $chan); + + if ( ($pubcount % $i) == 0 and $pubcount) { + sleep 1; + } elsif ($pubsize > $j) { + sleep 1; + $pubsize -= $j; + } + + } else { + $pubcount = 0; + $pubtime = $t; + $pubsize = length $msg; + } + + $conn->privmsg($talkchannel, $msg); +} + +sub msg { + my ($nick, $msg) = @_; + if (!defined $nick) { + &ERROR("msg: nick == NULL."); + return; + } + + if (!defined $msg) { + $msg ||= 'NULL'; + &WARN("msg: msg == $msg."); + return; + } + + # some say() end up here (eg +help) + if (&getChanConf('silent', $nick)) { + &DEBUG("msg: silent in $nick, not saying $msg"); + return; + } + + &status(">$nick< $msg"); + + return unless (&whatInterface() =~ /IRC/); + my $t = time(); + + if ($t == $msgtime) { + $msgcount++; + $msgsize += length $msg; + + my $i = &getChanConfDefault('sendPrivateLimitLines', 3, $chan); + my $j = &getChanConfDefault('sendPrivateLimitBytes', 1000, $chan); + if ( ($msgcount % $i) == 0 and $msgcount) { + sleep 1; + } elsif ($msgsize > $j) { + sleep 1; + $msgsize -= $j; + } + + } else { + $msgcount = 0; + $msgtime = $t; + $msgsize = length $msg; + } + + $conn->privmsg($nick, $msg); +} + +# Usage: &action(nick || chan, txt); +sub action { + my $mynick = $conn->nick(); + my ($target, $txt) = @_; + if (!defined $txt) { + &WARN("action: txt == NULL."); + return; + } + + if (&getChanConf('silent', $target)) { + &DEBUG("action: silent in $target, not doing $txt"); + return; + } + + if (length $txt > 480) { + &status("action: txt too long; truncating."); + chop($txt) while (length $txt > 480); + } + + &status("* $mynick/$target $txt"); + $conn->me($target, $txt); +} + +# Usage: ¬ice(nick || chan, txt); +sub notice { + my ($target, $txt) = @_; + if (!defined $txt) { + &WARN("notice: txt == NULL."); + return; + } + + &status("-$target- $txt"); + + my $t = time(); + + if ($t == $nottime) { + $notcount++; + $notsize += length $txt; + + my $i = &getChanConfDefault('sendNoticeLimitLines', 3, $chan); + my $j = &getChanConfDefault('sendNoticeLimitBytes', 1000, $chan); + + if ( ($notcount % $i) == 0 and $notcount) { + sleep 1; + } elsif ($notsize > $j) { + sleep 1; + $notsize -= $j; + } + + } else { + $notcount = 0; + $nottime = $t; + $notsize = length $txt; + } + + $conn->notice($target, $txt); +} + +sub DCCBroadcast { + my ($txt,$flag) = @_; + + ### FIXME: flag not supported yet. + + foreach (keys %{ $dcc{'CHAT'} }) { + $conn->privmsg($dcc{'CHAT'}{$_}, $txt); + } +} + +########## +### perform commands. +### + +# Usage: &performReply($reply); +sub performReply { + my ($reply) = @_; + + if (!defined $reply or $reply =~ /^\s*$/) { + &DEBUG("performReply: reply == NULL."); + return; + } + + $reply =~ /([\.\?\s]+)$/; + + # FIXME need real throttling.... + if (length($reply) > $maxlinelen - 30) { + $reply = substr($reply, 0, $maxlinelen - 33); + $reply =~ s/ [^ ]*?$/ .../; + } + &checkMsgType($reply); + + if ($msgType eq 'public') { + if (rand() < 0.5 or $reply =~ /[\.\?]$/) { + $reply = "$orig{who}: ".$reply; + } else { + $reply = "$reply, ".$orig{who}; + } + &say($reply); + + } elsif ($msgType eq 'private') { + if (rand() > 0.5) { + $reply = "$reply, ".$orig{who}; + } + &msg($who, $reply); + + } elsif ($msgType eq 'chat') { + if (!exists $dcc{'CHAT'}{$who}) { + &VERB("pSR: dcc{'CHAT'}{$who} does not exist.",2); + return; + } + $conn->privmsg($dcc{'CHAT'}{$who}, $reply); + + } else { + &ERROR("PR: msgType invalid? ($msgType)."); + } +} + +# ... +sub performAddressedReply { + return unless ($addressed); + &performReply(@_); +} + +# Usage: &performStrictReply($reply); +sub performStrictReply { + my ($reply) = @_; + + # FIXME need real throttling.... + if (length($reply) > $maxlinelen - 30) { + $reply = substr($reply, 0, $maxlinelen - 33); + $reply =~ s/ [^ ]*?$/ .../; + } + &checkMsgType($reply); + + if ($msgType eq 'private') { + &msg($who, $reply); + } elsif ($msgType eq 'public') { + &say($reply); + } elsif ($msgType eq 'chat') { + &dccsay(lc $who, $reply); + } else { + &ERROR("pSR: msgType invalid? ($msgType)."); + } +} + +sub dccsay { + my($who, $reply) = @_; + + if (!defined $reply or $reply =~ /^\s*$/) { + &WARN("dccsay: reply == NULL."); + return; + } + + if (!exists $dcc{'CHAT'}{$who}) { + &VERB("pSR: dcc{'CHAT'}{$who} does not exist. (2)",2); + return; + } + + &status("=>$who<= $reply"); # dcc chat. + $conn->privmsg($dcc{'CHAT'}{$who}, $reply); +} + +sub dcc_close { + my($who) = @_; + my $type; + + foreach $type (keys %dcc) { + &FIXME("dcc_close: $who"); + my @who = grep /^\Q$who\E$/i, keys %{ $dcc{$type} }; + next unless (scalar @who); + $who = $who[0]; + &DEBUG("dcc_close... close $who!"); + } +} + +sub joinchan { + my ($chan, $key) = @_; + $key ||= &getChanConf('chankey', $chan); + $key ||= ''; + + # forgot for about 2 years to implement channel keys when moving + # over to Net::IRC... + + # hopefully validChan is right. + if (&validChan($chan)) { + &status("join: already on $chan?"); + } + #} else { + &status("joining $b_blue$chan $key$ob"); + + return if ($conn->join($chan, $key)); + return if (&validChan($chan)); + + &DEBUG("joinchan: join failed. trying connect!"); + &clearIRCVars(); + $conn->connect(); + #} +} + +sub part { + my $chan; + + foreach $chan (@_) { + next if ($chan eq ''); + $chan =~ tr/A-Z/a-z/; # lowercase. + + if ($chan !~ /^$mask{chan}$/) { + &WARN("part: chan is invalid ($chan)"); + next; + } + + &status("parting $chan"); + if (!&validChan($chan)) { + &WARN("part: not on $chan; doing anyway"); +# next; + } + + $conn->part($chan); + # deletion of $channels{chan} is done in &entryEvt(). + } +} + +sub mode { + my ($chan, @modes) = @_; + my $modes = join(" ", @modes); + + if (&validChan($chan) == 0) { + &ERROR("mode: invalid chan => '$chan'."); + return; + } + + &DEBUG("mode: MODE $chan $modes"); + + # should move to use Net::IRC's $conn->mode()... but too lazy. + rawout("MODE $chan $modes"); +} + +sub op { + my ($chan, @who) = @_; + my $os = 'o' x scalar(@who); + + &mode($chan, "+$os @who"); +} + +sub deop { + my ($chan, @who) = @_; + my $os = 'o' x scalar(@who); + + &mode($chan, "-$os ".@who); +} + +sub kick { + my ($nick,$chan,$msg) = @_; + my (@chans) = ($chan eq '') ? (keys %channels) : lc($chan); + my $mynick = $conn->nick(); + + if ($chan ne '' and &validChan($chan) == 0) { + &ERROR("kick: invalid channel $chan."); + return; + } + + $nick =~ tr/A-Z/a-z/; + + foreach $chan (@chans) { + if (!&IsNickInChan($nick,$chan)) { + &status("kick: $nick is not on $chan.") if (scalar @chans == 1); + next; + } + + if (!exists $channels{$chan}{o}{$mynick}) { + &status("kick: do not have ops on $chan :("); + next; + } + + &status("Kicking $nick from $chan."); + $conn->kick($chan, $nick, $msg); + } +} + +sub ban { + my ($mask,$chan) = @_; + my (@chans) = ($chan =~ /^\*?$/) ? (keys %channels) : lc($chan); + my $mynick = $conn->nick(); + my $ban = 0; + + if ($chan !~ /^\*?$/ and &validChan($chan) == 0) { + &ERROR("ban: invalid channel $chan."); + return; + } + + foreach $chan (@chans) { + if (!exists $channels{$chan}{o}{$mynick}) { + &status("ban: do not have ops on $chan :("); + next; + } + + &status("Banning $mask from $chan."); + &rawout("MODE $chan +b $mask"); + $ban++; + } + + return $ban; +} + +sub unban { + my ($mask,$chan) = @_; + my (@chans) = ($chan =~ /^\*?$/) ? (keys %channels) : lc($chan); + my $mynick = $conn->nick(); + my $ban = 0; + + &DEBUG("unban: mask = $mask, chan = @chans"); + + foreach $chan (@chans) { + if (!exists $channels{$chan}{o}{$mynick}) { + &status("unBan: do not have ops on $chan :("); + next; + } + + &status("Removed ban $mask from $chan."); + &rawout("MODE $chan -b $mask"); + $ban++; + } + + return $ban; +} + +sub quit { + my ($quitmsg) = @_; + if (defined $conn) { + &status("QUIT " . $conn->nick() . " has quit IRC ($quitmsg)"); + $conn->quit($quitmsg); + } else { + &WARN("quit: could not quit!"); + } +} + +sub nick { + my ($newnick) = @_; + my $mynick = $conn->nick(); + + if (!defined $newnick) { + &ERROR("nick: nick == NULL."); + return; + } + + if (!defined $mynick) { + &WARN("nick: mynick == NULL."); + return; + } + + my $bad = 0; + $bad++ if (exists $nuh{$newnick}); + $bad++ if (&IsNickInAnyChan($newnick)); + + if ($bad) { + &WARN("Nick: not going to try to change from $mynick to $newnick. [". scalar(gmtime). "]"); + # hrm... over time we lose track of our own nick. + #return; + } + + if ($newnick =~ /^$mask{nick}$/) { + &status("nick: Changing nick from $mynick to $newnick"); + # ->nick() will NOT change cause we are using rawout? + &rawout("NICK $newnick"); + return 1; + } + &DEBUG("nick: failed... why oh why (mynick=$mynick, newnick=$newnick)"); + return 0; +} + +sub invite { + my($who, $chan) = @_; + # TODO: check if $who or $chan are invalid. + + $conn->invite($who, $chan); +} + +########## +# Channel related functions... +# + +# Usage: &joinNextChan(); +sub joinNextChan { + my $joined = 0; + foreach (sort keys %conns) { + $conn = $conns{$_}; + my $mynick = $conn->nick(); + my @join = getJoinChans(1); + + if (scalar @join) { + my $chan = shift @join; + &joinchan($chan); + + if (my $i = scalar @join) { + &status("joinNextChan: $mynick $i chans to join."); + } + $joined = 1; + } + } + return if $joined; + + if (exists $cache{joinTime}) { + my $delta = time() - $cache{joinTime} - 5; + my $timestr = &Time2String($delta); + # FIXME: @join should be @in instead (hacked to 10) + #my $rate = sprintf("%.1f", $delta / @in); + my $rate = sprintf("%.1f", $delta / 10); + delete $cache{joinTime}; + + &status("time taken to join all chans: $timestr; rate: $rate sec/join"); + } + + # chanserv check: global channels, in case we missed one. + foreach ( &ChanConfList('chanServ_ops') ) { + &chanServCheck($_); + } +} + +# Usage: &getNickInChans($nick); +sub getNickInChans { + my ($nick) = @_; + my @array; + + foreach (keys %channels) { + next unless (grep /^\Q$nick\E$/i, keys %{ $channels{$_}{''} }); + push(@array, $_); + } + + return @array; +} + +# Usage: &getNicksInChan($chan); +sub getNicksInChan { + my ($chan) = @_; + my @array; + + return keys %{ $channels{$chan}{''} }; +} + +sub IsNickInChan { + my ($nick,$chan) = @_; + + $chan =~ tr/A-Z/a-z/; # not lowercase unfortunately. + + if ($chan =~ /^$/) { + &DEBUG("INIC: chan == NULL."); + return 0; + } + + if (&validChan($chan) == 0) { + &ERROR("INIC: invalid channel $chan."); + return 0; + } + + if (grep /^\Q$nick\E$/i, keys %{ $channels{$chan}{''} }) { + return 1; + } else { + foreach (keys %channels) { + next unless (/[A-Z]/); + &DEBUG("iNIC: hash channels contains mixed cased chan!!!"); + } + return 0; + } +} + +sub IsNickInAnyChan { + my ($nick) = @_; + my $chan; + + foreach $chan (keys %channels) { + next unless (grep /^\Q$nick\E$/i, keys %{ $channels{$chan}{''} }); + return 1; + } + return 0; +} + +# Usage: &validChan($chan); +sub validChan { + # TODO: use $c instead? + my ($chan) = @_; + + if (!defined $chan or $chan =~ /^\s*$/) { + return 0; + } + + if (lc $chan ne $chan) { + &WARN("validChan: lc chan != chan. ($chan); fixing."); + $chan =~ tr/A-Z/a-z/; + } + + # it's possible that this check creates the hash if empty. + if (defined $channels{$chan} or exists $channels{$chan}) { + if ($chan =~ /^_?default$/) { +# &WARN("validC: chan cannot be _default! returning 0!"); + return 0; + } + + return 1; + } else { + return 0; + } +} + +### +# Usage: &delUserInfo($nick,@chans); +sub delUserInfo { + my ($nick,@chans) = @_; + my ($mode,$chan); + + foreach $chan (@chans) { + foreach $mode (keys %{ $channels{$chan} }) { + # use grep here? + next unless (exists $channels{$chan}{$mode}{$nick}); + + delete $channels{$chan}{$mode}{$nick}; + } + } +} + +sub clearChanVars { + my ($chan) = @_; + + delete $channels{$chan}; +} + +sub clearIRCVars { + undef %channels; + undef %floodjoin; + + $cache{joinTime} = time(); +} + +sub getJoinChans { + my($show) = @_; + + my @in; + my @skip; + my @join; + + # can't join any if not connected + return @join if (!$conn); + + my $nick = $conn->nick(); + + foreach (keys %chanconf) { + next if ($_ eq '_default'); + + my $skip = 0; + my $val = $chanconf{$_}{autojoin}; + + if (defined $val) { + $skip++ if ($val eq '0'); + if ($val eq '1') { + # convert old +autojoin to autojoin + $val = lc $nick; + $chanconf{$_}{autojoin} = $val; + } + $skip++ if (lc $val ne lc $nick); + } else { + $skip++; + } + + if ($skip) { + push(@skip, $_); + } else { + if (defined $channels{$_} or exists $channels{$_}) { + push(@in, $_); + } else { + push(@join, $_); + } + } + } + + my $str; + #$str .= ' in:' . join(',', sort @in) if scalar @in; + #$str .= ' skip:' . join(',', sort @skip) if scalar @skip; + $str .= ' join:' . join(',', sort @join) if scalar @join; + + &status("Chans: ($nick)$str") if ($show); + + return sort @join; +} + +sub closeDCC { +# &DEBUG("closeDCC called."); + my $type; + + foreach $type (keys %dcc) { + next if ($type ne uc($type)); + + my $nick; + foreach $nick (keys %{ $dcc{$type} }) { + next unless (defined $nick); + &status("DCC CHAT: closing DCC $type to $nick."); + next unless (defined $dcc{$type}{$nick}); + + my $ref = $dcc{$type}{$nick}; + &dccsay($nick, "bye bye, $nick") if ($type =~ /^chat$/i); + $dcc{$type}{$nick}->close(); + delete $dcc{$type}{$nick}; + &DEBUG("after close for $nick"); + } + delete $dcc{$type}; + } +} + +sub joinfloodCheck { + my($who,$chan,$userhost) = @_; + + return unless (&IsChanConf('joinfloodCheck') > 0); + + if (exists $netsplit{lc $who}) { # netsplit join. + &DEBUG("joinfloodCheck: $who was in netsplit; not checking."); + } + + if (exists $floodjoin{$chan}{$who}{Time}) { + &WARN("floodjoin{$chan}{$who} already exists?"); + } + + $floodjoin{$chan}{$who}{Time} = time(); + $floodjoin{$chan}{$who}{Host} = $userhost; + + ### Check... + foreach (keys %floodjoin) { + my $c = $_; + my $count = scalar keys %{ $floodjoin{$c} }; + next unless ($count > 5); + &DEBUG("joinflood: count => $count"); + + my $time; + foreach (keys %{ $floodjoin{$c} }) { + my $t = $floodjoin{$c}{$_}{Time}; + next unless (defined $t); + + $time += $t; + } + &DEBUG("joinflood: time => $time"); + $time /= $count; + + &DEBUG("joinflood: new time => $time"); + } + + ### Clean it up. + my $delete = 0; + my $time = time(); + foreach $chan (keys %floodjoin) { + foreach $who (keys %{ $floodjoin{$chan} }) { + my $t = $floodjoin{$chan}{$who}{Time}; + next unless (defined $t); + + my $delta = $time - $t; + next unless ($delta > 10); + + delete $floodjoin{$chan}{$who}; + $delete++; + } + } + + &DEBUG("joinfloodCheck: $delete deleted.") if ($delete); +} + +sub getHostMask { + my($n) = @_; + + if (exists $nuh{$n}) { + return &makeHostMask($nuh{$n}); + } else { + $cache{on_who_Hack} = 1; + $conn->who($n); + } +} + +1; diff --git a/src/IRC/IrcHelpers.pl b/src/IRC/IrcHelpers.pl new file mode 100644 index 0000000..e45b4b7 --- /dev/null +++ b/src/IRC/IrcHelpers.pl @@ -0,0 +1,385 @@ +# +# IrcHooks.pl: IRC Hooks stuff. +# Author: dms +# Version: 20010413 +# Created: 20010413 +# NOTE: Based on code by Kevin Lenzo & Patrick Cole (c) 1997 +# + +####################################################################### +####### IRC HOOK HELPERS IRC HOOK HELPERS IRC HOOK HELPERS ######## +####################################################################### + +##### +# Usage: &hookMode($nick, $modes, @targets); +sub hookMode { + my ($nick, $modes, @targets) = @_; + my $parity = 0; + + if ($chan =~ tr/A-Z/a-z/) { + &VERB("hookMode: cased $chan.",2); + } + + my $mode; + foreach $mode (split(//, $modes)) { + # sign. + if ($mode =~ /[-+]/) { + $parity = 1 if ($mode eq "+"); + $parity = 0 if ($mode eq "-"); + next; + } + + # mode with target. + if ($mode =~ /[bklov]/) { + my $target = shift @targets; + + if ($parity) { + $chanstats{$chan}{'Op'}++ if ($mode eq 'o'); + $chanstats{$chan}{'Ban'}++ if ($mode eq 'b'); + } else { + $chanstats{$chan}{'Deop'}++ if ($mode eq 'o'); + $chanstats{$chan}{'Unban'}++ if ($mode eq 'b'); + } + + # modes w/ target affecting nick => cache it. + if ($mode =~ /[bov]/) { + $channels{$chan}{$mode}{$target}++ if $parity; + delete $channels{$chan}{$mode}{$target} if !$parity; + + # lets do some custom stuff. + if ($mode eq 'o' and $parity) { + if ($nick eq 'ChanServ' and $target =~ /^\Q$ident\E$/i) { + &VERB("hookmode: chanserv deopped us! asking",2); + &chanServCheck($chan); + } + + &chanLimitVerify($chan); + } + } + + if ($mode =~ /[l]/) { + $channels{$chan}{$mode} = $target if $parity; + delete $channels{$chan}{$mode} if !$parity; + } + } + + # important channel modes, targetless. + if ($mode =~ /[mt]/) { + $channels{$chan}{$mode}++ if $parity; + delete $channels{$chan}{$mode} if !$parity; + } + } +} + +sub hookMsg { + ($msgType, $chan, $who, $message) = @_; + my $skipmessage = 0; + $addressed = 0; + $addressedother = 0; + $orig{message} = $message; + $orig{who} = $who; + $addrchar = 0; + + $message =~ s/[\cA-\c_]//ig; # strip control characters + $message =~ s/^\s+//; # initial whitespaces. + $who =~ tr/A-Z/a-z/; # lowercase. + my $mynick = $conn->nick(); + + &showProc(); + + # addressing. + if ($msgType =~ /private/) { + # private messages. + $addressed = 1; + if (&IsChanConf('addressCharacter') > 0) { + $addressCharacter = getChanConf('addressCharacter'); + if ($message =~ s/^\Q$addressCharacter\E//) { + &msg($who, "The addressCharacter \"$addressCharacter\" is to get my attention in a normal channel. Please leave it off when messaging me directly."); + } + } + } else { + # public messages. + # addressing revamped by the xk. + ### below needs to be fixed... + if (&IsChanConf('addressCharacter') > 0) { + $addressCharacter = getChanConf('addressCharacter'); + if ($message =~ s/^\Q$addressCharacter\E//) { + $addrchar = 1; + $addressed = 1; + } + } + + if ($message =~ /^($mask{nick})([\;\:\>\, ]+) */) { + my $newmessage = $'; + if ($1 =~ /^\Q$mynick\E$/i) { + $message = $newmessage; + $addressed = 1; + } else { + # ignore messages addressed to other people or unaddressed. + $skipmessage++ if ($2 ne '' and $2 !~ /^ /); + } + } + } + + # Determine floodwho. + my $c = '_default'; + if ($msgType =~ /public/i) { + # public. + $floodwho = $c = lc $chan; + } elsif ($msgType =~ /private/i) { + # private. + $floodwho = lc $who; + } else { + # dcc? + &FIXME("floodwho = ???"); + } + + my $val = &getChanConfDefault('floodRepeat', "2:5", $c); + my ($count, $interval) = split /:/, $val; + + # flood repeat protection. + if ($addressed) { + my $time = $flood{$floodwho}{$message} || 0; + + if (!&IsFlag('o') and $msgType eq 'public' and (time() - $time < $interval)) { + ### public != personal who so the below is kind of pointless. + my @who; + foreach (keys %flood) { + next if (/^\Q$floodwho\E$/); + next if (defined $chan and /^\Q$chan\E$/); + + push(@who, grep /^\Q$message\E$/i, keys %{ $flood{$_} }); + } + + return if ($lobotomized); + + if (!scalar @who) { + push(@who,'Someone'); + } + &msg($who,join(' ', @who)." already said that ". (time - $time) ." seconds ago" ); + + ### TODO: delete old floodwarn{} keys. + my $floodwarn = 0; + if (!exists $floodwarn{$floodwho}) { + $floodwarn++; + } else { + $floodwarn++ if (time() - $floodwarn{$floodwho} > $interval); + } + + if ($floodwarn) { + &status("FLOOD repetition detected from $floodwho."); + $floodwarn{$floodwho} = time(); + } + + return; + } + + if ($addrchar) { + &status("$b_cyan$who$ob is short-addressing $mynick"); + } elsif ($msgType eq 'private') { # private. + &status("$b_cyan$who$ob is /msg'ing $mynick"); + } else { # public? + &status("$b_cyan$who$ob is addressing $mynick"); + } + + $flood{$floodwho}{$message} = time(); + } elsif ($msgType eq 'public' and &IsChanConf('kickOnRepeat') > 0) { + # unaddressed, public only. + + ### TODO: use a separate "short-time" hash. + my @data; + @data = keys %{ $flood{$floodwho} } if (exists $flood{$floodwho}); + } + + $val = &getChanConfDefault('floodMessages', "5:30", $c); + ($count, $interval) = split /:/, $val; + + # flood overflow protection. + if ($addressed) { + foreach (keys %{ $flood{$floodwho} }) { + next unless (time() - $flood{$floodwho}{$_} > $interval); + delete $flood{$floodwho}{$_}; + } + + my $i = scalar keys %{ $flood{$floodwho} }; + if ($i > $count) { + my $expire = $param{'ignoreAutoExpire'} || 5; + +# &msg($who,"overflow of messages ($i > $count)"); + &msg($who,"Too many queries from you, ignoring for $expire minutes."); + &status("FLOOD overflow detected from $floodwho; ignoring"); + + &ignoreAdd("*!$uh", $chan, $expire, "flood overflow auto-detected."); + return; + } + + $flood{$floodwho}{$message} = time(); + } + + my @ignore; + if ($msgType =~ /public/i) { # public. + $talkchannel = $chan; + &status("<$orig{who}/$chan> $orig{message}"); + push(@ignore, keys %{ $ignore{$chan} }) if (exists $ignore{$chan}); + } elsif ($msgType =~ /private/i) { # private. + &status("[$orig{who}] $orig{message}"); + $talkchannel = undef; + $chan = '_default'; + } else { + &DEBUG("unknown msgType => $msgType."); + } + push(@ignore, keys %{ $ignore{'*'} }) if (exists $ignore{'*'}); + + if ((!$skipmessage or &IsChanConf('seenStoreAll') > 0) and + &IsChanConf('sed') > 0 and &IsChanConf('seen') > 0 and + $msgType =~ /public/ and + $orig{message} =~ /^s\/([^;\/]*)\/([^;\/]*)\/([g]*)$/) { + my $sedmsg = $seencache{$who}{'msg'}; + eval "\$sedmsg =~ s/\Q$1\E/\Q$2\E/$3;"; + $sedmsg =~ s/^(.{255}).*$/$1.../; # 255 char max to prevent flood + + if ($sedmsg ne $seencache{$who}{'msg'}) { + &DEBUG("sed \"" . $orig{message} . "\" \"" . + $seencache{$who}{'msg'} . "\" \"" . $sedmsg. "\""); + &msg($talkchannel, "$orig{who} meant: $sedmsg"); + } + } elsif ((!$skipmessage or &IsChanConf('seenStoreAll') > 0) and + &IsChanConf('seen') > 0 and $msgType =~ /public/) { + $seencache{$who}{'time'} = time(); + $seencache{$who}{'nick'} = $orig{who}; + $seencache{$who}{'host'} = $uh; + $seencache{$who}{'chan'} = $talkchannel; + $seencache{$who}{'msg'} = $orig{message}; + $seencache{$who}{'msgcount'}++; + } + if (&IsChanConf('minVolunteerLength') > 0) { + # FIXME hack to treat unaddressed as if using addrchar + $addrchar = 1; + } + return if ($skipmessage); + return unless ($addrchar or $addressed); + + foreach (@ignore) { + s/\*/\\S*/g; + + next unless (eval { $nuh =~ /^$_$/i } ); + + # better to ignore an extra message than to allow one to get + # through, although it would be better to go through ignore + # checking again. + if (time() - ($cache{ignoreCheckTime} || 0) > 60) { + &ignoreCheck(); + } + + &status("IGNORE <$who> $message"); + return; + } + + if (defined $nuh) { + if (!defined $userHandle) { + &DEBUG("line 1074: need verifyUser?"); + &verifyUser($who, $nuh); + } + } else { + &DEBUG("hookMsg: 'nuh' not defined?"); + } + +### For extra debugging purposes... + if ($_ = &process()) { +# &DEBUG("IrcHooks: process returned '$_'."); + } + + # hack to remove +o from ppl with +O flag. + if (exists $users{$userHandle} && exists $users{$userHandle}{FLAGS} && + $users{$userHandle}{FLAGS} =~ /O/ + ) { + $users{$userHandle}{FLAGS} =~ s/o//g; + } + + return; +} + +# this is basically run on on_join or on_quit +sub chanLimitVerify { + my($c) = @_; + $chan = $c; + my $l = $channels{$chan}{'l'}; + + return unless (&IsChanConf('chanlimitcheck') > 0); + + if (scalar keys %netsplit) { + &WARN("clV: netsplit active (1, chan = $chan); skipping."); + return; + } + + if (!defined $l) { + &DEBUG("$chan: running chanlimitCheck from chanLimitVerify."); + &chanlimitCheck(); + return; + } + + # only change it if it's not set. + my $plus = &getChanConfDefault('chanlimitcheckPlus', 5, $chan); + my $count = scalar(keys %{ $channels{$chan}{''} }); + my $int = &getChanConfDefault('chanlimitcheckInterval', 10, $chan); + + my $delta = $count + $plus - $l; +# $delta =~ s/^\-//; + + if ($plus <= 3) { + &WARN("clc: stupid to have plus at $plus, fix it!"); + } + + if (exists $cache{chanlimitChange}{$chan}) { + if (time() - $cache{chanlimitChange}{$chan} < $int*60) { + return; + } + } + + &chanServCheck($chan); + + ### TODO: unify code with chanlimitcheck() + return if ($delta > 5); + + &status("clc: big change in limit for $chan ($delta);". + "going for it. (was: $l; now: ".($count+$plus).")"); + + $conn->mode($chan, "+l", $count+$plus); + $cache{chanlimitChange}{$chan} = time(); +} + +sub chanServCheck { + ($chan) = @_; + + if (!defined $chan or $chan =~ /^\s*$/) { + &WARN("chanServCheck: chan == NULL."); + return 0; + } + + if ($chan =~ tr/A-Z/a-z/) { + &DEBUG("chanServCheck: lowercased chan ($chan)"); + } + + if (! &IsChanConf('chanServ_ops') > 0) { + return 0; + } + + &VERB("chanServCheck($chan) called.",2); + + if ( &IsParam('nickServ_pass') and !$nickserv) { + $conn->who('NickServ'); + return 0; + } + + # check for first hash then for next hash. + # TODO: a function for &ischanop()? &isvoice()? + if (exists $channels{$chan} and exists $channels{$chan}{'o'}{$ident}) { + return 0; + } + + &status("ChanServ ==> Requesting ops for $chan. (chanServCheck)"); + &rawout("PRIVMSG ChanServ :OP $chan $ident"); + return 1; +} + +1; diff --git a/src/IRC/IrcHooks.pl b/src/IRC/IrcHooks.pl new file mode 100644 index 0000000..47f9851 --- /dev/null +++ b/src/IRC/IrcHooks.pl @@ -0,0 +1,1281 @@ +# +# IrcHooks.pl: IRC Hooks stuff. +# Author: dms +# Version: 20000126 +# NOTE: Based on code by Kevin Lenzo & Patrick Cole (c) 1997 +# +use vars qw(%chanconf); + +# GENERIC. TO COPY. +sub on_generic { + $conn = shift(@_); + my ($event) = @_; + my $nick = $event->nick(); + my $chan = ($event->to)[0]; + + &DEBUG("on_generic: nick => '$nick'."); + &DEBUG("on_generic: chan => '$chan'."); + + foreach ($event->args) { + &DEBUG("on_generic: args => '$_'."); + } +} + +sub on_action { + $conn = shift(@_); + my ($event) = @_; + my ($nick, @args) = ($event->nick, $event->args); + my $chan = ($event->to)[0]; + + shift @args; + + if ($chan eq $ident) { + &status("* [$nick] @args"); + } else { + &status("* $nick/$chan @args"); + } +} + +sub on_chat { + $conn = shift(@_); + my ($event) = @_; + my $msg = ($event->args)[0]; + my $sock = ($event->to)[0]; + my $nick = lc $event->nick(); + + if (!exists $nuh{$nick}) { + &DEBUG("chat: nuh{$nick} doesn't exist; trying WHOIS ."); + $conn->whois($nick); + return; + } + + ### set vars that would have been set in hookMsg. + $userHandle = ''; # reset. + $who = lc $nick; + $message = $msg; + $orig{who} = $nick; + $orig{message} = $msg; + $nuh = $nuh{$who}; + $uh = (split /\!/, $nuh)[1]; + $h = (split /\@/, $uh)[1]; + $addressed = 1; + $msgType = 'chat'; + + if (!exists $dcc{'CHATvrfy'}{$nick}) { + $userHandle = &verifyUser($who, $nuh); + my $crypto = $users{$userHandle}{PASS}; + my $success = 0; + + if ($userHandle eq '_default') { + &WARN("DCC CHAT: _default/guest not allowed."); + return; + } + + ### TODO: prevent users without CRYPT chatting. + if (!defined $crypto) { + &TODO("dcc close chat"); + &msg($who, "nope, no guest logins allowed..."); + return; + } + + if (&ckpasswd($msg, $crypto)) { + # stolen from eggdrop. + $conn->privmsg($sock, "Connected to $ident"); + $conn->privmsg($sock, "Commands start with '.' (like '.quit' or '.help')"); + $conn->privmsg($sock, "Everything else goes out to the party line."); + + &dccStatus(2) unless (exists $sched{'dccStatus'}{RUNNING}); + + $success++; + + } else { + &status("DCC CHAT: incorrect pass; closing connection."); + &DEBUG("chat: sock => '$sock'."); +### $sock->close(); + delete $dcc{'CHAT'}{$nick}; + &FIXME("chat: after closing sock."); + ### BUG: close seizes bot. why? + } + + if ($success) { + &status("DCC CHAT: user $nick is here!"); + &DCCBroadcast("*** $nick ($uh) joined the party line."); + + $dcc{'CHATvrfy'}{$nick} = $userHandle; + + return if ($userHandle eq '_default'); + + &dccsay($nick,"Flags: $users{$userHandle}{FLAGS}"); + } + + return; + } + + &status("$b_red=$b_cyan$who$b_red=$ob $message"); + + if ($message =~ s/^\.//) { # dcc chat commands. + ### TODO: make use of &Forker(); here? + &loadMyModule('UserDCC'); + + &DCCBroadcast("#$who# $message",'m'); + + my $retval = &userDCC(); + return unless (defined $retval); + return if ($retval eq $noreply); + + $conn->privmsg($dcc{'CHAT'}{$who}, "Invalid command."); + + } else { # dcc chat arena. + + foreach (keys %{ $dcc{'CHAT'} }) { + $conn->privmsg($dcc{'CHAT'}{$_}, "<$who> $orig{message}"); + } + } + + return 'DCC CHAT MESSAGE'; +} + +# is there isoff? how do we know if someone signs off? +sub on_ison { + $conn = shift(@_); + my ($event) = @_; + my $x1 = ($event->args)[0]; + my $x2 = ($event->args)[1]; + $x2 =~ s/\s$//; + + &DEBUG("on_ison: x1 = '$x1', x2 => '$x2'"); +} + +sub on_endofmotd { + $conn = shift(@_); + + # update IRCStats. + $ident = $conn->nick(); + $ircstats{'ConnectTime'} = time(); + $ircstats{'ConnectCount'}++; + if (defined $ircstats{'DisconnectTime'}) { + $ircstats{'OffTime'} += time() - $ircstats{'DisconnectTime'}; + } + + # first time run. + if (!exists $users{_default}) { + &status("!!! First time run... adding _default user."); + $users{_default}{FLAGS} = 'amrt'; + $users{_default}{HOSTS}{"*!*@*"} = 1; + } + + if (scalar keys %users < 2) { + &status("!"x40); + &status("!!! Ok. Now type '/msg $ident PASS ' to get master access through DCC CHAT."); + &status("!"x40); + } + # end of first time run. + + if (&IsChanConf('Wingate') > 0) { + my $file = "$bot_base_dir/$param{'ircUser'}.wingate"; + open(IN, $file); + while () { + chop; + next unless (/^(\S+)\*$/); + push(@wingateBad, $_); + } + close IN; + } + + if ($firsttime) { + &ScheduleThis(1, 'setupSchedulers'); + $firsttime = 0; + } + + if (&IsParam('ircUMode')) { + &VERB("Attempting change of user modes to $param{'ircUMode'}.", 2); + if ($param{'ircUMode'} !~ /^[-+]/) { + &WARN("ircUMode had no +- prefix; adding +"); + $param{'ircUMode'} = "+".$param{'ircUMode'}; + } + + &rawout("MODE $ident $param{'ircUMode'}"); + } + + # ok, we're free to do whatever we want now. go for it! + $running = 1; + + # add ourself to notify. + $conn->ison($conn->nick()); + + # Q, as on quakenet.org. + if (&IsParam('Q_pass')) { + &status("Authing to Q..."); + &rawout("PRIVMSG Q\@CServe.quakenet.org :AUTH $param{'Q_user'} $param{'Q_pass'}"); + } + + &status("End of motd. Now lets join some channels..."); + #&joinNextChan(); +} + +sub on_endofwho { + $conn = shift(@_); + my ($event) = @_; +# &DEBUG("endofwho: chan => $chan"); + $chan ||= ($event->args)[1]; +# &DEBUG("endofwho: chan => $chan"); + + if (exists $cache{countryStats}) { + &do_countrystats(); + } +} + +sub on_dcc { + $conn = shift(@_); + my ($event) = @_; + my $type = uc( ($event->args)[1] ); + my $nick = lc $event->nick(); + + &status("on_dcc type=$type nick=$nick sock=$sock"); + + # pity Net::IRC doesn't store nuh. Here's a hack :) + if (!exists $nuh{lc $nick}) { + $conn->whois($nick); + $nuh{$nick} = "GETTING-NOW"; # trying. + } + $type ||= "???"; + + if ($type eq 'SEND') { # GET for us. + # incoming DCC SEND. we're receiving a file. + my $get = ($event->args)[2]; + &status("DCC: not Initializing GET from $nick to '$param{tempDir}/$get'"); + # FIXME: do we want to get anything? + return; + #open(DCCGET,">$param{tempDir}/$get"); + #$conn->new_get($event, \*DCCGET); + + } elsif ($type eq 'GET') { # SEND for us? + &status("DCC: not Initializing SEND for $nick."); + # FIXME: do we want to do anything? + return; + $conn->new_send($event->args); + + } elsif ($type eq 'CHAT') { + &status("DCC: Initializing CHAT for $nick."); + $conn->new_chat($event); +# $conn->new_chat(1, $nick, $event->host); + + } else { + &WARN("${b_green}DCC $type$ob (1)"); + } +} + +sub on_dcc_close { + $conn = shift(@_); + my ($event) = @_; + my $nick = $event->nick(); + my $sock = ($event->to)[0]; + + # DCC CHAT close on fork exit workaround. + if ($bot_pid != $$) { + &WARN("run-away fork; exiting."); + &delForked($forker); + } + + if (exists $dcc{'SEND'}{$nick} and -f "$param{tempDir}/$nick.txt") { + &status("${b_green}DCC SEND$ob close from $b_cyan$nick$ob"); + + &status("dcc_close: purging DCC send $nick.txt"); + unlink "$param{tempDir}/$nick.txt"; + + delete $dcc{'SEND'}{$nick}; + } elsif (exists $dcc{'CHAT'}{$nick} and $dcc{'CHAT'}{$nick} eq $sock) { + &status("${b_green}DCC CHAT$ob close from $b_cyan$nick$ob"); + delete $dcc{'CHAT'}{$nick}; + delete $dcc{'CHATvrfy'}{$nick}; + } else { + &status("${b_green}DCC$ob UNKNOWN close from $b_cyan$nick$ob (2)"); + } +} + +sub on_dcc_open { + $conn = shift(@_); + my ($event) = @_; + my $type = uc( ($event->args)[0] ); + my $nick = lc $event->nick(); + my $sock = ($event->to)[0]; + + &status("on_dcc_open type=$type nick=$nick sock=$sock"); + + $msgType = 'chat'; + $type ||= "???"; + ### BUG: who is set to bot's nick? + + # lets do it. + if ($type eq 'SEND') { + &status("${b_green}DCC lGET$ob established with $b_cyan$nick$ob"); + + } elsif ($type eq 'CHAT') { + # very cheap hack. + ### TODO: run ScheduleThis inside on_dcc_open_chat recursively + ### 1,3,5,10 seconds then fail. + if ($nuh{$nick} eq "GETTING-NOW") { + &ScheduleThis(3/60, 'on_dcc_open_chat', $nick, $sock); + } else { + on_dcc_open_chat(undef, $nick, $sock); + } + + } elsif ($type eq 'SEND') { + &status("Starting DCC receive."); + foreach ($event->args) { + &status(" => '$_'."); + } + + } else { + &WARN("${b_green}DCC $type$ob (3)"); + } +} + +# really custom sub to get NUH since Net::IRC doesn't appear to support +# it. +sub on_dcc_open_chat { + my(undef, $nick, $sock) = @_; + + if ($nuh{$nick} eq "GETTING-NOW") { + &FIXME("getting nuh for $nick failed."); + return; + } + + &status("${b_green}DCC CHAT$ob established with $b_cyan$nick$ob $b_yellow($ob$nuh{$nick}$b_yellow)$ob"); + + &verifyUser($nick, $nuh{lc $nick}); + + if (!exists $users{$userHandle}{HOSTS}) { + &performStrictReply("you have no hosts defined in my user file; rejecting."); + $sock->close(); + return; + } + + my $crypto = $users{$userHandle}{PASS}; + $dcc{'CHAT'}{$nick} = $sock; + + # TODO: don't make DCC CHAT established in the first place. + if ($userHandle eq '_default') { + &dccsay($nick, "_default/guest not allowed"); + $sock->close(); + return; + } + + if (defined $crypto) { + &status("DCC CHAT: going to use ".$nick."'s crypt."); + &dccsay($nick,"Enter your password."); + } else { +# &dccsay($nick,"Welcome to infobot DCC CHAT interface, $userHandle."); + } +} + +sub on_disconnect { + $conn = shift(@_); + my ($event) = @_; + my $from = $event->from(); + my $what = ($event->args)[0]; + my $mynick=$conn->nick(); + + &status("$mynick disconnect from $from ($what)."); + $ircstats{'DisconnectTime'} = time(); + $ircstats{'DisconnectReason'} = $what; + $ircstats{'DisconnectCount'}++; + $ircstats{'TotalTime'} += time() - $ircstats{'ConnectTime'} + if ($ircstats{'ConnectTime'}); + + # clear any variables on reconnection. + $nickserv = 0; + + &clearIRCVars(); + + if (!defined $conn) { + &WARN("on_disconnect: self is undefined! WTF"); + &DEBUG("running function irc... lets hope this works."); + &irc(); + return; + } + + &WARN("scheduling call ircCheck() in 60s"); + &clearIRCVars(); + &ScheduleThis(1, 'ircCheck'); +} + +sub on_endofnames { + $conn = shift(@_); + my ($event) = @_; + my $chan = ($event->args)[1]; + + # sync time should be done in on_endofwho like in BitchX + if (exists $cache{jointime}{$chan}) { + my $delta_time = sprintf("%.03f", &timedelta($cache{jointime}{$chan}) ); + $delta_time = 0 if ($delta_time <= 0); + if ($delta_time > 100) { + &WARN("endofnames: delta_time > 100 ($delta_time)"); + } + + &status("$b_blue$chan$ob: sync in ${delta_time}s."); + } + + $conn->mode($chan); + + my $txt; + my @array; + foreach ('o','v','') { + my $count = scalar(keys %{ $channels{$chan}{$_} }); + next unless ($count); + + $txt = 'total' if ($_ eq ''); + $txt = 'voice' if ($_ eq 'v'); + $txt = 'ops' if ($_ eq 'o'); + + push(@array, "$count $txt"); + } + my $chanstats = join(' || ', @array); + &status("$b_blue$chan$ob: [$chanstats]"); + + &chanServCheck($chan); + # schedule used to solve ircu (OPN) "target too fast" problems. + $conn->schedule(5, sub { &joinNextChan(); } ); +} + +sub on_init { + $conn = shift(@_); + my ($event) = @_; + my (@args) = ($event->args); + shift @args; + + &status("@args"); +} + +sub on_invite { + $conn = shift(@_); + my ($event) = @_; + my $chan = lc( ($event->args)[0] ); + my $nick = $event->nick; + + if ($nick =~ /^\Q$ident\E$/) { + &DEBUG("on_invite: self invite."); + return; + } + + ### TODO: join key. + if (exists $chanconf{$chan}) { + # it's still buggy :/ + if (&validChan($chan)) { + &msg($who, "i'm already in \002$chan\002."); +# return; + } + + &status("invited to $b_blue$chan$ob by $b_cyan$nick$ob"); + &joinchan($chan); + } +} + +sub on_join { + $conn = shift(@_); + my ($event) = @_; + my ($user,$host) = split(/\@/, $event->userhost); + $chan = lc( ($event->to)[0] ); # CASING!!!! + $who = $event->nick(); + $msgType = 'public'; + my $i = scalar(keys %{ $channels{$chan} }); + my $j = $cache{maxpeeps}{$chan} || 0; + + if (!&IsParam('noSHM') && time() > ($sched{shmFlush}{TIME} || time()) + 3600) { + &DEBUG("looks like schedulers died somewhere... restarting..."); + &setupSchedulers(); + } + + $chanstats{$chan}{'Join'}++; + $userstats{lc $who}{'Join'} = time() if (&IsChanConf('seenStats') > 0); + $cache{maxpeeps}{$chan} = $i if ($i > $j); + + &joinfloodCheck($who, $chan, $event->userhost); + + # netjoin detection. + my $netsplit = 0; + if (exists $netsplit{lc $who}) { + delete $netsplit{lc $who}; + $netsplit = 1; + + if (!scalar keys %netsplit) { + &DEBUG("on_join: netsplit hash is now empty!"); + undef %netsplitservers; + &netsplitCheck(); # any point in running this? + &chanlimitCheck(); + } + } + + if ($netsplit and !exists $cache{netsplit}) { + &VERB("on_join: ok.... re-running chanlimitCheck in 60.",2); + $conn->schedule(60, sub { + &chanlimitCheck(); + delete $cache{netsplit}; + } ); + + $cache{netsplit} = time(); + } + + # how to tell if there's a netjoin??? + + my $netsplitstr = ''; + $netsplitstr = " $b_yellow\[${ob}NETSPLIT VICTIM$b_yellow]$ob" if ($netsplit); + &status(">>> join/$b_blue$chan$ob $b_cyan$who$ob $b_yellow($ob$user\@$host$b_yellow)$ob$netsplitstr"); + + $channels{$chan}{''}{$who}++; + $nuh = $who."!".$user."\@".$host; + $nuh{lc $who} = $nuh unless (exists $nuh{lc $who}); + + ### on-join bans. + my @bans; + push(@bans, keys %{ $bans{$chan} }) if (exists $bans{$chan}); + push(@bans, keys %{ $bans{'*'} }) if (exists $bans{'*'}); + + foreach (@bans) { + my $ban = $_; + s/\?/./g; + s/\*/\\S*/g; + my $mask = $_; + next unless ($nuh =~ /^$mask$/i); + + ### TODO: check $channels{$chan}{'b'} if ban already exists. + foreach (keys %{ $channels{$chan}{'b'} }) { + &DEBUG(" bans_on_chan($chan) => $_"); + } + + my $reason = "no reason"; + foreach ($chan, '*') { + next unless (exists $bans{$_}); + next unless (exists $bans{$_}{$ban}); + + my @array = @{ $bans{$_}{$ban} }; + + $reason = $array[4] if ($array[4]); + last; + } + + &ban($ban, $chan); + &kick($who, $chan, $reason); + + last; + } + + # no need to go further. + return if ($netsplit); + + # who == bot. + if ($who =~ /^\Q$ident\E$/i) { + if (defined( my $whojoin = $cache{join}{$chan} )) { + &msg($chan, "Okay, I'm here. (courtesy of $whojoin)"); + delete $cache{join}{$chan}; + &joinNextChan(); # hack. + } + + ### TODO: move this to &joinchan()? + $cache{jointime}{$chan} = &timeget(); + $conn->who($chan); + + return; + } + + ### ROOTWARN: + &rootWarn($who,$user,$host,$chan) if ( + &IsChanConf('RootWarn') > 0 && + $user =~ /^~?r(oo|ew|00)t$/i + ); + + ### emit a message based on who just joined + &onjoin($who,$user,$host,$chan) if (&IsChanConf('OnJoin') > 0); + + ### NEWS: + if (&IsChanConf('News') > 0 && &IsChanConf('newsKeepRead') > 0) { + if (!&loadMyModule('News')) { # just in case. + &DEBUG('could not load news.'); + } else { + &News::latest($chan); + } + } + + ### botmail: + if (&IsChanConf('botmail') > 0) { + &botmail::check(lc $who); + } + + ### wingate: + &wingateCheck(); +} + +sub on_kick { + $conn = shift(@_); + my ($event) = @_; + my ($chan,$reason) = $event->args; + my $kicker = $event->nick; + my $kickee = ($event->to)[0]; + my $uh = $event->userhost(); + + &status(">>> kick/$b_blue$chan$ob [$b$kickee!$uh$ob] by $b_cyan$kicker$ob $b_yellow($ob$reason$b_yellow)$ob"); + + $chan = lc $chan; # forgot about this, found by xsdg, 20001229. + $chanstats{$chan}{'Kick'}++; + + if ($kickee eq $ident) { + &clearChanVars($chan); + + &status("SELF attempting to rejoin lost channel $chan"); + &joinchan($chan); + } else { + &delUserInfo($kickee,$chan); + } +} + +sub on_mode { + $conn = shift(@_); + my ($event) = @_; + my ($user, $host) = split(/\@/, $event->userhost); + my @args = $event->args(); + my $nick = $event->nick(); + $chan = ($event->to)[0]; + + # last element is empty... so nuke it. + pop @args while ($args[$#args] eq ''); + + if ($nick eq $chan) { # UMODE + &status(">>> mode $b_yellow\[$ob$b@args$b_yellow\]$ob by $b_cyan$nick$ob"); + } else { # MODE + &status(">>> mode/$b_blue$chan$ob $b_yellow\[$ob$b@args$b_yellow\]$ob by $b_cyan$nick$ob"); + &hookMode($nick, @args); + } +} + +sub on_modeis { + $conn = shift(@_); + my ($event) = @_; + my ($myself, undef,@args) = $event->args(); + my $nick = $event->nick(); + $chan = ($event->args())[1]; + + &hookMode($nick, @args); +} + +sub on_msg { + $conn = shift(@_); + my ($event) = @_; + my $nick = $event->nick; + my $msg = ($event->args)[0]; + + ($user,$host) = split(/\@/, $event->userhost); + $uh = $event->userhost(); + $nuh = $nick."!".$uh; + $msgtime = time(); + $h = $host; + + if ($nick eq $ident) { # hopefully ourselves. + if ($msg eq 'TEST') { + &status("IRCTEST: Yes, we're alive."); + delete $cache{connect}; + return; + } + } + + &hookMsg('private', undef, $nick, $msg); + $who = ''; + $chan = ''; + $msgType = ''; +} + +sub on_names { + $conn = shift(@_); + my ($event) = @_; + my @args = $event->args; + my $chan = lc $args[2]; # CASING, the last of them! + + foreach (split / /, @args[3..$#args]) { + $channels{$chan}{'o'}{$_}++ if s/\@//; + $channels{$chan}{'v'}{$_}++ if s/\+//; + $channels{$chan}{''}{$_}++; + } +} + +sub on_nick { + $conn = shift(@_); + my ($event) = @_; + my $nick = $event->nick(); + my $newnick = ($event->args)[0]; + + if (exists $netsplit{lc $newnick}) { + &status("Netsplit: $newnick/$nick came back from netsplit and changed to original nick! removing from hash."); + delete $netsplit{lc $newnick}; + &netsplitCheck() if (time() != $sched{netsplitCheck}{TIME}); + } + + my ($chan,$mode); + foreach $chan (keys %channels) { + foreach $mode (keys %{ $channels{$chan} }) { + next unless (exists $channels{$chan}{$mode}{$nick}); + + $channels{$chan}{$mode}{$newnick} = $channels{$chan}{$mode}{$nick}; + } + } + # TODO: do %flood* aswell. + + &delUserInfo($nick, keys %channels); + $nuh{lc $newnick} = $nuh{lc $nick}; + delete $nuh{lc $nick}; + + if ($nick eq $conn->nick()) { + &status(">>> I materialized into $b_green$newnick$ob from $nick"); + $ident = $newnick; + $conn->nick($newnick); + } else { + &status(">>> $b_cyan$nick$ob materializes into $b_green$newnick$ob"); + my $mynick=$conn->nick(); + if ($nick =~ /^\Q$mynick\E$/i) { + &getNickInUse(); + } + } +} + +sub on_nick_taken { + $conn = shift(@_); + my $nick = $conn->nick(); + #my $newnick = $nick . int(rand 10); + my $newnick = $nick . '_'; + + &DEBUG("on_nick_taken: nick => $nick"); + + &status("nick taken ($nick); preparing nick change."); + + $conn->whois($nick); + #$conn->schedule(5, sub { + &status("nick taken; changing to temporary nick ($nick -> $newnick)."); + &nick($newnick); + #} ); +} + +sub on_notice { + $conn = shift(@_); + my ($event) = @_; + my $nick = $event->nick(); + my $chan = ($event->to)[0]; + my $args = ($event->args)[0]; + + if ($nick =~ /^NickServ$/i) { # nickserv. + &status("NickServ: <== '$args'"); + + my $check = 0; + $check++ if ($args =~ /^This nickname is registered/i); + $check++ if ($args =~ /nickname.*owned/i); + + if ($check) { + &status("nickserv told us to register; doing it."); + + if (&IsParam('nickServ_pass')) { + &status("NickServ: ==> Identifying."); + &rawout("PRIVMSG NickServ :IDENTIFY $param{'nickServ_pass'}"); + return; + } else { + &status("We can't tell nickserv a passwd ;("); + } + } + + # password accepted. + if ($args =~ /^Password a/i) { + my $done = 0; + + foreach ( &ChanConfList('chanServ_ops') ) { + next unless &chanServCheck($_); + next if ($done); + &DEBUG("nickserv activated or restarted; doing chanserv check."); + $done++; + } + + $nickserv++; + } + + } elsif ($nick =~ /^ChanServ$/i) { # chanserv. + &status("ChanServ: <== '$args'."); + + } else { + if ($chan =~ /^$mask{chan}$/) { # channel notice. + &status("-$nick/$chan- $args"); + } else { + $server = $nick unless (defined $server); + &status("-$nick- $args"); # private or server notice. + } + } +} + +sub on_other { + $conn = shift(@_); + my ($event) = @_; + my $chan = ($event->to)[0]; + my $nick = $event->nick; + + &status("!!! other called."); + &status("!!! $event->args"); +} + +sub on_part { + $conn = shift(@_); + my ($event) = @_; + $chan = lc( ($event->to)[0] ); # CASING!!! + my $mynick = $conn->nick(); + my $nick = $event->nick; + my $userhost = $event->userhost; + $who = $nick; + $msgType = 'public'; + + if (!exists $channels{$chan}) { + &DEBUG("on_part: found out $mynick is on $chan!"); + $channels{$chan} = 1; + } + + if (exists $floodjoin{$chan}{$nick}{Time}) { + delete $floodjoin{$chan}{$nick}; + } + + $chanstats{$chan}{'Part'}++; + &delUserInfo($nick,$chan); + if ($nick eq $ident) { + &clearChanVars($chan); + } + + if (!&IsNickInAnyChan($nick) and &IsChanConf('seenStats') > 0) { + delete $userstats{lc $nick}; + } + + &status(">>> part/$b_blue$chan$ob $b_cyan$nick$ob $b_yellow($ob$userhost$b_yellow)$ob"); +} + +sub on_ping { + $conn = shift(@_); + my ($event) = @_; + my $nick = $event->nick; + + $conn->ctcp_reply($nick, join(' ', ($event->args))); + &status(">>> ${b_green}CTCP PING$ob request from $b_cyan$nick$ob received."); +} + +sub on_ping_reply { + $conn = shift(@_); + my ($event) = @_; + my $nick = $event->nick; + my $t = ($event->args)[1]; + if (!defined $t) { + &WARN("on_ping_reply: t == undefined."); + return; + } + + my $lag = time() - $t; + + &status(">>> ${b_green}CTCP PING$ob reply from $b_cyan$nick$ob: $lag sec."); +} + +sub on_public { + $conn = shift(@_); + my ($event) = @_; + my $msg = ($event->args)[0]; + $chan = lc( ($event->to)[0] ); # CASING. + my $nick = $event->nick; + $who = $nick; + $uh = $event->userhost(); + $nuh = $nick."!".$uh; + $msgType = 'public'; + # TODO: move this out of hookMsg to here? + ($user,$host) = split(/\@/, $uh); + $h = $host; + + # rare case should this happen - catch it just in case. + if ($bot_pid != $$) { + &ERROR("run-away fork; exiting."); + &delForked($forker); + } + + $msgtime = time(); + $lastWho{$chan} = $nick; + ### TODO: use $nick or lc $nick? + if (&IsChanConf('seenStats') > 0) { + $userstats{lc $nick}{'Count'}++; + $userstats{lc $nick}{'Time'} = time(); + } + + # cache it. + my $time = time(); + if (!$cache{ircTextCounters}) { + &DEBUG("caching ircTextCounters for first time."); + my @str = split(/\s+/, &getChanConf('ircTextCounters')); + for (@str) { $_ = quotemeta($_); } + $cache{ircTextCounters} = join('|', @str); + } + + my $str = $cache{ircTextCounters}; + if ($str && $msg =~ /^($str)[\s!\.]?$/i) { + my $x = $1; + + &VERB("textcounters: $x matched for $who",2); + my $c = $chan || 'PRIVATE'; + + # better to do "counter=counter+1". + # but that will avoid time check. + my ($v,$t) = &sqlSelect('stats', "counter,time", { + nick => $who, + type => $x, + channel => $c, + } ); + $v++; + + # don't allow ppl to cheat the stats :-) + if (defined $t && $time - $t > 60) { + &sqlSet('stats', {'nick' => $who}, { + type => $x, + channel => $c, + time => $time, + counter => $v, + } ); + } + } + + &hookMsg('public', $chan, $nick, $msg); + $chanstats{$chan}{'PublicMsg'}++; + $who = ''; + $chan = ''; + $msgType = ''; +} + +sub on_quit { + $conn = shift(@_); + my ($event) = @_; + my $nick = $event->nick(); + my $reason = ($event->args)[0]; + + # hack for ICC. + $msgType = 'public'; + $who = $nick; +### $chan = $reason; # no. + + my $count = 0; + foreach (grep !/^_default$/, keys %channels) { + # fixes inconsistent chanstats bug #1. + if (!&IsNickInChan($nick,$_)) { + $count++; + next; + } + $chanstats{$_}{'SignOff'}++; + } + + if ($count == scalar keys %channels) { + &DEBUG("on_quit: nick $nick was not found in any chan."); + } + + # should fix chanstats inconsistencies bug #2. + if ($reason =~ /^($mask{host})\s($mask{host})$/) { # netsplit. + $reason = "NETSPLIT: $1 <=> $2"; + + # chanlimit code. + foreach $chan ( &getNickInChans($nick) ) { + next unless ( &IsChanConf('chanlimitcheck') > 0); + next unless ( exists $channels{$_}{'l'} ); + + &DEBUG("on_quit: netsplit detected on $_; disabling chan limit."); + $conn->mode($_, "-l"); + } + + $netsplit{lc $nick} = time(); + if (!exists $netsplitservers{$1}{$2}) { + &status("netsplit detected between $1 and $2 at [".scalar(gmtime)."]"); + $netsplitservers{$1}{$2} = time(); + } + } + + my $chans = join(' ', &getNickInChans($nick) ); + &status(">>> $b_cyan$nick$ob has signed off IRC $b_red($ob$reason$b_red)$ob [$chans]"); + + ### + ### ok... lets clear out the cache + ### + &delUserInfo($nick, keys %channels); + if (exists $nuh{lc $nick}) { + delete $nuh{lc $nick}; + } else { + # well.. it's good but weird that this has happened - lets just + # be quiet about it. + } + delete $userstats{lc $nick} if (&IsChanConf('seenStats') > 0); + delete $chanstats{lc $nick}; + ### + + # if we have a temp nick, and whoever is camping on our main nick leaves + # revert to main nick. Note that Net::IRC only knows our main nick + if ($nick eq $conn->nick()) { + &status("nickchange: own nick \"$nick\" became free; changing."); + &nick($mynick); + } +} + +sub on_targettoofast { + $conn = shift(@_); + my ($event) = @_; + my $nick = $event->nick(); + my($me,$chan,$why) = $event->args(); + + ### TODO: incomplete. + if ($why =~ /.* wait (\d+) second/) { + my $sleep = $1; + my $max = 10; + + if ($sleep > $max) { + &status("targettoofast: going to sleep for $max ($sleep)..."); + $sleep = $max; + } else { + &status("targettoofast: going to sleep for $sleep"); + } + + my $delta = time() - ($cache{sleepTime} || 0); + if ($delta > $max+2) { + sleep $sleep; + $cache{sleepTime} = time(); + } + + return; + } + + if (!exists $cache{TargetTooFast}) { + &DEBUG("on_ttf: failed: $why"); + $cache{TargetTooFast}++; + } +} + +sub on_topic { + $conn = shift(@_); + my ($event) = @_; + + if (scalar($event->args) == 1) { # change. + my $topic = ($event->args)[0]; + my $chan = ($event->to)[0]; + my $nick = $event->nick(); + + ### + # WARNING: + # race condition here. To fix, change '1' to '0'. + # This will keep track of topics set by bot only. + ### + # UPDATE: + # this may be fixed at a later date with topic queueing. + ### + + $topic{$chan}{'Current'} = $topic if (1); + $chanstats{$chan}{'Topic'}++; + + &status(">>> topic/$b_blue$chan$ob by $b_cyan$nick$ob -> $topic"); + } else { # join. + my ($nick, $chan, $topic) = $event->args; + if (&IsChanConf('Topic') > 0) { + $topic{$chan}{'Current'} = $topic; + &topicAddHistory($chan,$topic); + } + + $topic = &fixString($topic, 1); + &status(">>> topic/$b_blue$chan$ob is $topic"); + } +} + +sub on_topicinfo { + $conn = shift(@_); + my ($event) = @_; + my ($myself,$chan,$setby,$time) = $event->args(); + + my $timestr; + if (time() - $time > 60*60*24) { + $timestr = "at ". gmtime $time; + } else { + $timestr = &Time2String(time() - $time) ." ago"; + } + + &status(">>> set by $b_cyan$setby$ob $timestr"); +} + +sub on_crversion { + $conn = shift(@_); + my ($event) = @_; + my $nick = $event->nick(); + my $ver; + + if (scalar $event->args() != 1) { # old. + $ver = join ' ', $event->args(); + $ver =~ s/^VERSION //; + } else { # new. + $ver = ($event->args())[0]; + } + + if (grep /^\Q$nick\E$/i, @vernick) { + &WARN("nick $nick found in vernick ($ver); skipping."); + return; + } + push(@vernick, $nick); + + if ($ver =~ /bitchx/i) { + $ver{bitchx}{$nick} = $ver; + + } elsif ($ver =~ /xc\!|xchat/i) { + $ver{xchat}{$nick} = $ver; + + } elsif ($ver =~ /irssi/i) { + $ver{irssi}{$nick} = $ver; + + } elsif ($ver =~ /epic|(Third Eye)/i) { + $ver{epic}{$nick} = $ver; + + } elsif ($ver =~ /ircII|PhoEniX/i) { + $ver{ircII}{$nick} = $ver; + + } elsif ($ver =~ /mirc/i) { +# &DEBUG("verstats: mirc: $nick => '$ver'."); + $ver{mirc}{$nick} = $ver; + +# ok... then we get to the lesser known/used clients. + } elsif ($ver =~ /ircle/i) { + $ver{ircle}{$nick} = $ver; + + } elsif ($ver =~ /chatzilla/i) { + $ver{chatzilla}{$nick} = $ver; + + } elsif ($ver =~ /pirch/i) { + $ver{pirch}{$nick} = $ver; + + } elsif ($ver =~ /sirc /i) { + $ver{sirc}{$nick} = $ver; + + } elsif ($ver =~ /kvirc/i) { + $ver{kvirc}{$nick} = $ver; + + } elsif ($ver =~ /eggdrop/i) { + $ver{eggdrop}{$nick} = $ver; + + } elsif ($ver =~ /xircon/i) { + $ver{xircon}{$nick} = $ver; + + } else { + &DEBUG("verstats: other: $nick => '$ver'."); + $ver{other}{$nick} = $ver; + } +} + +sub on_version { + $conn = shift(@_); + my ($event) = @_; + my $nick = $event->nick; + + &status(">>> ${b_green}CTCP VERSION$ob request from $b_cyan$nick$ob"); + $conn->ctcp_reply($nick, "VERSION $bot_version"); +} + +sub on_who { + $conn = shift(@_); + my ($event) = @_; + my @args = $event->args; + my $str = $args[5]."!".$args[2]."\@".$args[3]; + + if ($cache{on_who_Hack}) { + $cache{nuhInfo}{lc $args[5]}{Nick} = $args[5]; + $cache{nuhInfo}{lc $args[5]}{User} = $args[2]; + $cache{nuhInfo}{lc $args[5]}{Host} = $args[3]; + $cache{nuhInfo}{lc $args[5]}{NUH} = "$args[5]!$args[2]\@$args[3]"; + return; + } + + if ($args[5] =~ /^nickserv$/i and !$nickserv) { + &DEBUG("ok... we did a who for nickserv."); + &rawout("PRIVMSG NickServ :IDENTIFY $param{'nickServ_pass'}"); + } + + $nuh{lc $args[5]} = $args[5]."!".$args[2]."\@".$args[3]; +} + +sub on_whois { + $conn = shift(@_); + my ($event) = @_; + my @args = $event->args; + + $nuh{lc $args[1]} = $args[1]."!".$args[2]."\@".$args[3]; +} + +sub on_whoischannels { + $conn = shift(@_); + my ($event) = @_; + my @args = $event->args; + + &DEBUG("on_whoischannels: @args"); +} + +sub on_useronchannel { + $conn = shift(@_); + my ($event) = @_; + my @args = $event->args; + + &DEBUG("on_useronchannel: @args"); + &joinNextChan(); +} + +### +### since joinnextchan is hooked onto on_endofnames, these are needed. +### + +sub on_chanfull { + $conn = shift(@_); + my ($event) = @_; + my @args = $event->args; + + &status(">>> chanfull/$b_blue$args[1]$ob"); + + &joinNextChan(); +} + +sub on_inviteonly { + $conn = shift(@_); + my ($event) = @_; + my @args = $event->args; + + &status(">>> inviteonly/$b_cyan$args[1]$ob"); + + &joinNextChan(); +} + +sub on_banned { + $conn = shift(@_); + my ($event) = @_; + my @args = $event->args; + my $chan = $args[1]; + + &status(">>> banned/$b_blue$chan$ob $b_cyan$args[0]$ob, removing autojoin for $chan"); + delete $chanconf{$chan}{autojoin}; + &joinNextChan(); +} + +sub on_badchankey { + $conn = shift(@_); + my ($event) = @_; + my @args = $event->args; + my $chan = $args[1]; + + &DEBUG("on_badchankey: args => @args, removing autojoin for $chan"); + delete $chanconf{$chan}{autojoin}; + &joinNextChan(); +} + +sub on_useronchan { + $conn = shift(@_); + my ($event) = @_; + my @args = $event->args; + + &DEBUG("on_useronchan: args => @args"); + &joinNextChan(); +} + +# TODO not used yet +sub on_stdin { + my $line = ; + chomp($line); + &FIXME("on_stdin: line => \"$line\""); +} + +1; diff --git a/src/IRC/Schedulers.pl b/src/IRC/Schedulers.pl new file mode 100644 index 0000000..7c3044d --- /dev/null +++ b/src/IRC/Schedulers.pl @@ -0,0 +1,1116 @@ +# +# ProcessExtra.pl: Extensions to Process.pl +# Author: dms +# Version: v0.5 (20010124) +# Created: 20000117 +# + +# use strict; # TODO + +use POSIX qw(strftime); +use vars qw(%sched %schedule); + +# format: function name = ( +# str chanconfdefault, +# int internaldefault, +# bool deferred, +# int next run, (optional) +# ) + +#%schedule = { +# uptimeLoop => ('', 60, 1), +#}; + +sub setupSchedulersII { + foreach (keys %schedule) { + &queueTask($_, @{ $schedule{$_} }); + } +} + +sub queueTask { + my($codename, $chanconfdef, $intervaldef, $defer) = @_; + my $t = &getChanConfDefault($chanconfdef, $intervaldef, $chan); + my $waittime = &getRandomInt($t); + + if (!defined $waittime) { + &WARN("interval == waittime == UNDEF for $codename."); + return; + } + + my $time = $schedule{$codename}[3]; + if (defined $time and $time > time()) { + &WARN("Sched for $codename already exists in " . &Time2String(time() - $time) . "."); + return; + } + + #&VERB("Scheduling \&$codename() for " . &Time2String($waittime),3); + + my $retval = $conn->schedule($waittime, sub { + \&$codename; + }, @args ); +} + +sub setupSchedulers { + &VERB("Starting schedulers...",2); + + # ONCE OFF. + + # REPETITIVE. + # 2 for on next-run. + &randomQuote(2); + &randomFactoid(2); + &seenFlush(2); + &leakCheck(2); # mandatory + &seenFlushOld(2); + &miscCheck2(2); # mandatory + &slashdotLoop(2); + &plugLoop(2); + &kernelLoop(2); + &wingateWriteFile(2); + &factoidCheck(2); # takes a couple of seconds on a 486. defer it +# TODO: convert to new format... or nuke altogether. + &newsFlush(2); + + # 1 for run straight away + &uptimeLoop(1); + &logLoop(1); + &chanlimitCheck(1); + &netsplitCheck(1); # mandatory + &floodLoop(1); # mandatory + &ignoreCheck(1); # mandatory + &miscCheck(1); # mandatory + &shmFlush(1); # mandatory + sleep 1; + &ircCheck(1); # mandatory + + # TODO: squeeze this into a one-liner. +# my $count = map { exists $sched{$_}{TIME} } keys %sched; + my $count = 0; + foreach (keys %sched) { + my $time = $sched{$_}{TIME}; + next unless (defined $time and $time > time()); + + $count++; + } + + &status("Schedulers: $count will be running."); + &scheduleList(); +} + +sub ScheduleThis { + my ($interval, $codename, @args) = @_; + my $waittime = &getRandomInt($interval); + + if (!defined $waittime) { + &WARN("interval == waittime == UNDEF for $codename."); + return; + } + + my $time = $sched{$codename}{TIME}; + if (defined $time and $time > time()) { + &WARN("Sched for $codename already exists in " . &Time2String(time() - $time) . "."); + return; + } + + &DEBUG("Scheduling \&$codename() " . \&$codename . " for " . &Time2String($waittime),3); + + my $retval = $conn->schedule($waittime, \&$codename, @args); + $sched{$codename}{LABEL} = $retval; + $sched{$codename}{TIME} = time()+$waittime; + $sched{$codename}{LOOP} = 1; +} + +#### +#### LET THE FUN BEGIN. +#### + +sub randomQuote { + my $interval = &getChanConfDefault('randomQuoteInterval', 60, $chan); + if (@_) { + &ScheduleThis($interval, 'randomQuote'); + return if ($_[0] eq '2'); # defer. + } + + foreach ( &ChanConfList('randomQuote') ) { + next unless (&validChan($_)); + + my $line = &getRandomLineFromFile($bot_data_dir. "/infobot.randtext"); + if (!defined $line) { + &ERROR("random Quote: weird error?"); + return; + } + + &status("sending random Quote to $_."); + &action($_, "Ponders: ".$line); + } + ### TODO: if there were no channels, don't reschedule until channel + ### configuration is modified. +} + +sub randomFactoid { + my ($key,$val); + my $error = 0; + + my $interval = &getChanConfDefault('randomFactoidInterval', 60, $chan); + if (@_) { + &ScheduleThis($interval, 'randomFactoid'); + return if ($_[0] eq '2'); # defer. + } + + foreach ( &ChanConfList('randomFactoid') ) { + next unless (&validChan($_)); + + &status("sending random Factoid to $_."); + while (1) { + ($key,$val) = &randKey('factoids',"factoid_key,factoid_value"); + &DEBUG("rF: $key, $val"); +### $val =~ tr/^[A-Z]/[a-z]/; # blah is Good => blah is good. + last if ((defined $val) and ($val !~ /^ $param{'maxLogSize'}) { + my $date = sprintf("%04d%02d%02d", (gmtime)[5,4,3]); + $file{log} = $param{'logfile'} ."-". $date; + &status("cycling log file."); + + if ( -e $file{log}) { + my $i = 1; + my $newlog; + while () { + $newlog = $file{log}."-".$i; + last if (! -e $newlog); + $i++; + } + $file{log} = $newlog; + } + + &closeLog(); + CORE::system("/bin/mv '$param{'logfile'}' '$file{log}'"); + &compress($file{log}); + &openLog(); + &status("cycling log file."); + } + + ### check if all the logs exceed size. + if (!opendir(LOGS, $bot_log_dir)) { + &WARN("logLoop: could not open dir '$bot_log_dir'"); + return; + } + + my $tsize = 0; + my (%age, %size); + while (defined($_ = readdir LOGS)) { + my $logfile = "$bot_log_dir/$_"; + + next unless ( -f $logfile); + + my $size = -s $logfile; + my $age = (stat $logfile)[9]; + $age{$age} = $logfile; + $size{$logfile} = $size; + $tsize += $size; + } + closedir LOGS; + + my $delete = 0; + while ($tsize > $param{'maxLogSize'}) { + &status("LOG: current size > max ($tsize > $param{'maxLogSize'})"); + my $oldest = (sort {$a <=> $b} keys %age)[0]; + &status("LOG: unlinking $age{$oldest}."); + unlink $age{$oldest}; + $tsize -= $oldest; + $delete++; + } + + ### TODO: add how many b,kb,mb removed? + &status("LOG: removed $delete logs.") if ($delete); +} + +sub seenFlushOld { + if (@_) { + &ScheduleThis(1440, 'seenFlushOld'); + return if ($_[0] eq '2'); # defer. + } + + # is this global-only? + return unless (&IsChanConf('seen') > 0); + return unless (&IsChanConf('seenFlushInterval') > 0); + + # global setting. does not make sense for per-channel. + my $max_time = &getChanConfDefault('seenMaxDays', 30, $chan) *60*60*24; + my $delete = 0; + + if ($param{'DBType'} =~ /^(pgsql|mysql|sqlite(2)?)$/i) { + my $query; + + if ($param{'DBType'} =~ /^(mysql|sqlite(2)?)$/i) { + $query = "SELECT nick,time FROM seen GROUP BY nick HAVING ". + "UNIX_TIMESTAMP() - time > $max_time"; + } else { # pgsql. + $query = "SELECT nick,time FROM seen WHERE ". + "extract(epoch from timestamp 'now') - time > $max_time"; + } + + my $sth = $dbh->prepare($query); + if ($sth->execute) { + while (my @row = $sth->fetchrow_array) { + my ($nick,$time) = @row; + + &sqlDelete('seen', { nick => $nick } ); + $delete++; + } + $sth->finish; + } + } else { + &FIXME("seenFlushOld: for bad DBType:" . $param{'DBType'} . "."); + } + &VERB("SEEN deleted $delete seen entries.",2); + +} + +sub newsFlush { + if (@_) { + &ScheduleThis(60, 'newsFlush'); + return if ($_[0] eq '2'); # defer. + } + + if (!&ChanConfList('News')) { + &DEBUG("newsFlush: news disabled? (chan => $chan)"); + return; + } + + my $delete = 0; + my $oldest = time(); + my %none; + foreach $chan (keys %::news) { + my $i = 0; + my $total = scalar(keys %{ $::news{$chan} }); + + if (!$total) { + delete $::news{$chan}; + next; + } + + foreach $item (keys %{ $::news{$chan} }) { + my $t = $::news{$chan}{$item}{Expire}; + + my $tadd = $::news{$chan}{$item}{Time}; + $oldest = $tadd if ($oldest > $tadd); + + next if ($t == 0 or $t == -1); + if ($t < 1000) { + &status("newsFlush: Fixed Expire time for $chan/$item, should not happen anyway."); + $::news{$chan}{$item}{Expire} = time() + $t*60*60*24; + next; + } + + my $delta = $t - time(); + + next unless (time() > $t); + + # TODO: show how old it was. + delete $::news{$chan}{$item}; + &status("NEWS: (newsflush) deleted '$item'"); + $delete++; + $i++; + } + + &status("NEWS (newsflush) {$chan}: deleted [$i/$total] news entries.") if ($i); + $none{$chan} = 1 if ($total == $i); + } + + # TODO: flush users aswell. + my $duser = 0; + foreach $chan (keys %::newsuser) { + next if (exists $none{$chan}); + + foreach (keys %{ $::newsuser{$chan} }) { + my $t = $::newsuser{$chan}{$_}; + if (!defined $t or ($t > 2 and $t < 1000)) { + &DEBUG("something wrong with newsuser{$chan}{$_} => $t"); + next; + } + + next unless ($oldest > $t); + + delete $::newsuser{$chan}{$_}; + $duser++; + } + + my $i = scalar(keys %{ $::newsuser{$chan} }); + delete $::newsuser{$chan} unless ($i); + } + + if ($delete or $duser) { + &status("NewsFlush: deleted: $delete news entries; $duser user cache."); + } +} + +sub chanlimitCheck { + my $interval = &getChanConfDefault('chanlimitcheckInterval', 10, $chan); + my $mynick=$conn->nick(); + + if (@_) { + &ScheduleThis($interval, 'chanlimitCheck'); + return if ($_[0] eq '2'); + } + + my $str = join(' ', &ChanConfList('chanlimitcheck') ); + + foreach $chan ( &ChanConfList('chanlimitcheck') ) { + next unless (&validChan($chan)); + + if ($chan eq '_default') { + &WARN("chanlimit: we're doing $chan!! HELP ME!"); + next; + } + + my $limitplus = &getChanConfDefault('chanlimitcheckPlus', 5, $chan); + my $newlimit = scalar(keys %{ $channels{$chan}{''} }) + $limitplus; + my $limit = $channels{$chan}{'l'}; + + if (scalar keys %netsplitservers) { + if (defined $limit) { + &status("chanlimit: netsplit; removing it for $chan."); + $conn->mode($chan, "-l"); + $cache{chanlimitChange}{$chan} = time(); + &status("chanlimit: netsplit; removed."); + } + + next; + } + + if (defined $limit and scalar keys %{ $channels{$chan}{''} } > $limit) { + &FIXME("LIMIT: set too low!!!"); + ### run NAMES again and flush it. + } + + if (defined $limit and $limit == $newlimit) { + $cache{chanlimitChange}{$chan} = time(); + next; + } + + if (!exists $channels{$chan}{'o'}{$mynick}) { + &status("chanlimit: dont have ops on $chan.") unless (exists $cache{warn}{chanlimit}{$chan}); + $cache{warn}{chanlimit}{$chan} = 1; + &chanServCheck($chan); + next; + } + delete $cache{warn}{chanlimit}{$chan}; + + if (!defined $limit) { + &status("chanlimit: $chan: setting for first time or from netsplit."); + } + + if (exists $cache{chanlimitChange}{$chan}) { + my $delta = time() - $cache{chanlimitChange}{$chan}; + if ($delta < $interval*60) { + &DEBUG("chanlimit: not going to change chanlimit! ($delta<$interval*60)"); + return; + } + } + + $conn->mode($chan, "+l", $newlimit); + $cache{chanlimitChange}{$chan} = time(); + } +} + +sub netsplitCheck { + my ($s1,$s2); + + if (@_) { + &ScheduleThis(15, 'netsplitCheck'); + return if ($_[0] eq '2'); + } + + $cache{'netsplitCache'}++; +# &DEBUG("running netsplitCheck... $cache{netsplitCache}"); + + if (!scalar %netsplit and scalar %netsplitservers) { + &DEBUG("nsC: !hash netsplit but hash netsplitservers <- removing!"); + undef %netsplitservers; + return; + } + + # well... this shouldn't happen since %netsplit code does it anyway. + foreach $s1 (keys %netsplitservers) { + + foreach $s2 (keys %{ $netsplitservers{$s1} }) { + my $delta = time() - $netsplitservers{$s1}{$s2}; + + if ($delta > 60*30) { + &status("netsplit between $s1 and $s2 appears to be stale."); + delete $netsplitservers{$s1}{$s2}; + &chanlimitCheck(); + } + } + + my $i = scalar(keys %{ $netsplitservers{$s1} }); + delete $netsplitservers{$s1} unless ($i); + } + + # %netsplit hash checker. + my $count = scalar keys %netsplit; + my $delete = 0; + foreach (keys %netsplit) { + if (&IsNickInAnyChan($_)) { # why would this happen? +# &DEBUG("nsC: $_ is in some chan; removing from netsplit list."); + delete $netsplit{$_}; + $delete++; + next; + } + + next unless (time() - $netsplit{$_} > 60*15); + + $delete++; + delete $netsplit{$_}; + } + + # yet another hack. + foreach (keys %channels) { + my $i = $cache{maxpeeps}{$chan} || 0; + my $j = scalar(keys %{ $channels{$chan} }); + next unless ($i > 10 and 0.25*$i > $j); + + &DEBUG("netsplit: 0.25*max($i) > current($j); possible netsplit?"); + } + + if ($delete) { + my $j = scalar(keys %netsplit); + &status("nsC: removed from netsplit list: (before: $count; after: $j)"); + } + + if (!scalar %netsplit and scalar %netsplitservers) { + &DEBUG("nsC: ok hash netsplit is NULL; purging hash netsplitservers"); + undef %netsplitservers; + } + + if ($count and !scalar keys %netsplit) { + &DEBUG("nsC: netsplit is hopefully gone. reinstating chanlimit check."); + &chanlimitCheck(); + } +} + +sub floodLoop { + my $delete = 0; + my $who; + + if (@_) { + &ScheduleThis(60, 'floodLoop'); # minutes. + return if ($_[0] eq '2'); + } + + my $time = time(); + my $interval = &getChanConfDefault('floodCycle',60, $chan); + + foreach $who (keys %flood) { + foreach (keys %{ $flood{$who} }) { + if (!exists $flood{$who}{$_}) { + &WARN("flood{$who}{$_} undefined?"); + next; + } + + if ($time - $flood{$who}{$_} > $interval) { + delete $flood{$who}{$_}; + $delete++; + } + } + } + &VERB("floodLoop: deleted $delete items.",2); +} + +sub seenFlush { + if (@_) { + my $interval = &getChanConfDefault('seenFlushInterval', 60, $chan); + &ScheduleThis($interval, 'seenFlush'); + return if ($_[0] eq '2'); + } + + my %stats; + my $nick; + my $flushed = 0; + $stats{'count_old'} = &countKeys('seen') || 0; + $stats{'new'} = 0; + $stats{'old'} = 0; + + if ($param{'DBType'} =~ /^(mysql|pgsql|sqlite(2)?)$/i) { + foreach $nick (keys %seencache) { + my $retval = &sqlSet('seen', {'nick' => lc $seencache{$nick}{'nick'}}, { + time => $seencache{$nick}{'time'}, + host => $seencache{$nick}{'host'}, + channel => $seencache{$nick}{'chan'}, + message => $seencache{$nick}{'msg'}, + } ); + + delete $seencache{$nick}; + $flushed++; + } + } else { + &DEBUG("seenFlush: NO VALID FACTOID SUPPORT?"); + } + + &status("Seen: Flushed $flushed entries.") if ($flushed); + &VERB(sprintf(" new seen: %03.01f%% (%d/%d)", + $stats{'new'}*100/($stats{'count_old'} || 1), + $stats{'new'}, ( $stats{'count_old'} || 1) ), 2) if ($stats{'new'}); + &VERB(sprintf(" now seen: %3.1f%% (%d/%d)", + $stats{'old'}*100 / ( &countKeys('seen') || 1), + $stats{'old'}, &countKeys('seen') ), 2) if ($stats{'old'}); + + &WARN("scalar keys seenflush != 0!") if (scalar keys %seenflush); +} + +sub leakCheck { + my ($blah1,$blah2); + my $count = 0; + + if (@_) { + &ScheduleThis(240, 'leakCheck'); + return if ($_[0] eq '2'); + } + + # flood. this is dealt with in floodLoop() + foreach $blah1 (keys %flood) { + foreach $blah2 (keys %{ $flood{$blah1} }) { + $count += scalar(keys %{ $flood{$blah1}{$blah2} }); + } + } + &VERB("leak: hash flood has $count total keys.",2); + + # floodjoin. + $count = 0; + foreach $blah1 (keys %floodjoin) { + foreach $blah2 (keys %{ $floodjoin{$blah1} }) { + $count += scalar(keys %{ $floodjoin{$blah1}{$blah2} }); + } + } + &VERB("leak: hash floodjoin has $count total keys.",2); + + # floodwarn. + $count = scalar(keys %floodwarn); + &VERB("leak: hash floodwarn has $count total keys.",2); + + my $chan; + foreach $chan (grep /[A-Z]/, keys %channels) { + &DEBUG("leak: chan => '$chan'."); + my ($i,$j); + foreach $i (keys %{ $channels{$chan} }) { + foreach (keys %{ $channels{$chan}{$i} }) { + &DEBUG("leak: \$channels{$chan}{$i}{$_} ..."); + } + } + } + + # chanstats + $count = scalar(keys %chanstats); + &VERB("leak: hash chanstats has $count total keys.",2); + + # nuh. + my $delete = 0; + foreach (keys %nuh) { + next if (&IsNickInAnyChan($_)); + next if (exists $dcc{CHAT}{$_}); + + delete $nuh{$_}; + $delete++; + } + + &status("leak: $delete nuh{} items deleted; now have ". + scalar(keys %nuh) ) if ($delete); +} + +sub ignoreCheck { + if (@_) { + &ScheduleThis(60, 'ignoreCheck'); + return if ($_[0] eq '2'); # defer. + } + + my $time = time(); + my $count = 0; + + foreach (keys %ignore) { + my $chan = $_; + + foreach (keys %{ $ignore{$chan} }) { + my @array = @{ $ignore{$chan}{$_} }; + + next unless ($array[0] and $time > $array[0]); + + delete $ignore{$chan}{$_}; + &status("ignore: $_/$chan has expired."); + $count++; + } + } + + $cache{ignoreCheckTime} = time(); + + &VERB("ignore: $count items deleted.",2); +} + +sub ircCheck { + if (@_) { + &ScheduleThis(15, 'ircCheck'); + return if ($_[0] eq '2'); # defer. + } + + $cache{statusSafe} = 1; + foreach (sort keys %conns) { + $conn=$conns{$_}; + my $mynick=$conn->nick(); + &DEBUG("ircCheck for $_"); + my @join = &getJoinChans(1); + if (scalar @join) { + &FIXME('ircCheck: found channels to join! ' . join(',',@join)); + &joinNextChan(); + } + + # TODO: fix on_disconnect() + + if (time() - $msgtime > 3600) { + # TODO: shouldn't we use cache{connect} somewhere? + if (exists $cache{connect}) { + &WARN("ircCheck: no msg for 3600 and disco'd! reconnecting!"); + $msgtime = time(); # just in case. + &ircloop(); + delete $cache{connect}; + } else { + &status('ircCheck: possible lost in space; checking.'. + scalar(gmtime) ); + &msg($mynick, 'TEST'); + $cache{connect} = time(); + } + } + + if (grep /^\s*$/, keys %channels) { + &WARN('ircCheck: we have a NULL chan in hash channels? removing!'); + if (!exists $channels{''}) { + &DEBUG('ircCheck: this should never happen!'); + } + + delete $channels{''}; + } + } + + $cache{statusSafe} = 0; + + ### USER FILE. + if ($utime_userfile > $wtime_userfile and time() - $wtime_userfile > 3600) { + &writeUserFile(); + $wtime_userfile = time(); + } + ### CHAN FILE. + if ($utime_chanfile > $wtime_chanfile and time() - $wtime_chanfile > 3600) { + &writeChanFile(); + $wtime_chanfile = time(); + } +} + +sub miscCheck { + if (@_) { + &ScheduleThis(120, 'miscCheck'); + return if ($_[0] eq '2'); # defer. + } + + # SHM check. + my @ipcs; + if ( -x "/usr/bin/ipcs") { + @ipcs = `/usr/bin/ipcs`; + } else { + &WARN("ircCheck: no 'ipcs' binary."); + return; + } + + # make backup of important files. + &mkBackup( $bot_state_dir."/infobot.chan", 60*60*24*3); + &mkBackup( $bot_state_dir."/infobot.users", 60*60*24*3); + &mkBackup( $bot_base_dir."/infobot-news.txt", 60*60*24*1); + + # flush cache{lobotomy} + foreach (keys %{ $cache{lobotomy} }) { + next unless (time() - $cache{lobotomy}{$_} > 60*60); + delete $cache{lobotomy}{$_}; + } + + ### check modules if they've been modified. might be evil. + &reloadAllModules(); + + # shmid stale remove. + foreach (@ipcs) { + chop; + + # key, shmid, owner, perms, bytes, nattch + next unless (/^(0x\d+) (\d+)\s+(\S+)\s+(\d+)\s+(\d+)\s+/); + + my ($shmid, $size) = ($2,$5); + next unless ($shmid != $shm and $size == 2000); + my $z = &shmRead($shmid); + if ($z =~ /^(\S+):(\d+):(\d+): /) { + my $n = $1; + my $pid = $2; + my $time = $3; + next if (time() - $time < 60*60); + # FIXME remove not-pid shm if parent process dead + next if ($pid == $bot_pid); + # don't touch other bots, if they're running. + next unless ($param{ircUser} =~ /^\Q$n\E$/); + } else { + &DEBUG("shm: $shmid is not ours or old infobot => ($z)"); + next; + } + + &status("SHM: nuking shmid $shmid"); + CORE::system("/usr/bin/ipcrm shm $shmid >/dev/null"); + } +} + +sub miscCheck2 { + if (@_) { + &ScheduleThis(240, 'miscCheck2'); + return if ($_[0] eq '2'); # defer. + } + + # debian check. + opendir(DEBIAN, "$bot_state_dir/debian"); + foreach ( grep /gz$/, readdir(DEBIAN) ) { + my $exit = CORE::system("gzip -t $bot_state_dir/debian/$_"); + next unless ($exit); + + &status("debian: unlinking file => $_"); + unlink "$bot_state_dir/debian/$_"; + } + closedir DEBIAN; + + # compress logs that should have been compressed. + # TODO: use strftime? + my ($day,$month,$year) = (gmtime(time()))[3,4,5]; + my $date = sprintf("%04d%02d%02d",$year+1900,$month+1,$day); + + if (!opendir(DIR,"$bot_log_dir")) { + &ERROR("misccheck2: log dir $bot_log_dir does not exist."); + closedir DIR; + return -1; + } + + while (my $f = readdir(DIR)) { + next unless ( -f "$bot_log_dir/$f"); + next if ($f =~ /gz|bz2/); + next unless ($f =~ /(\d{8})/); + next if ($date eq $1); + + &compress("$bot_log_dir/$f"); + } + closedir DIR; +} + +### this is semi-scheduled +sub getNickInUse { +# FIXME: broken for multiple connects +# if ($ident eq $param{'ircNick'}) { +# &status("okay, got my nick back."); +# return; +# } +# +# if (@_) { +# &ScheduleThis(30, 'getNickInUse'); +# return if ($_[0] eq '2'); # defer. +# } +# +# &nick( $param{'ircNick'} ); +} + +sub uptimeLoop { + return if (!defined &uptimeWriteFile); +# return unless &IsParam('Uptime'); + + if (@_) { + &ScheduleThis(60, 'uptimeLoop'); + return if ($_[0] eq '2'); # defer. + } + + &uptimeWriteFile(); +} + +sub slashdotLoop { + + if (@_) { + &ScheduleThis(60, 'slashdotLoop'); + return if ($_[0] eq '2'); + } + + my @chans = &ChanConfList('slashdotAnnounce'); + return unless (scalar @chans); + + &Forker('slashdot', sub { + my $line = &Slashdot::slashdotAnnounce(); + return unless (defined $line); + + foreach (@chans) { + next unless (&::validChan($_)); + + &::status("sending slashdot update to $_."); + ¬ice($_, "Slashdot: $line"); + } + } ); +} + +sub plugLoop { + + if (@_) { + &ScheduleThis(60, 'plugLoop'); + return if ($_[0] eq '2'); + } + + my @chans = &ChanConfList('plugAnnounce'); + return unless (scalar @chans); + + &Forker('Plug', sub { + my $line = &Plug::plugAnnounce(); + return unless (defined $line); + + foreach (@chans) { + next unless (&::validChan($_)); + + &::status("sending plug update to $_."); + ¬ice($_, "Plug: $line"); + } + } ); +} + +sub kernelLoop { + if (@_) { + &ScheduleThis(240, 'kernelLoop'); + return if ($_[0] eq '2'); + } + + my @chans = &ChanConfList('kernelAnnounce'); + return unless (scalar @chans); + + &Forker('Kernel', sub { + my @data = &Kernel::kernelAnnounce(); + + foreach (@chans) { + next unless (&::validChan($_)); + + &::status("sending kernel update to $_."); + my $c = $_; + foreach (@data) { + ¬ice($c, "Kernel: $_"); + } + } + } ); +} + +sub wingateCheck { + return unless &IsChanConf('Wingate') > 0; + + ### FILE CACHE OF OFFENDING WINGATES. + foreach (grep /^$host$/, @wingateBad) { + &status("Wingate: RUNNING ON $host BY $who"); + &ban("*!*\@$host", '') if &IsChanConf('wingateBan') > 0; + + my $reason = &getChanConf('wingateKick'); + + next unless ($reason); + &kick($who, '', $reason) + } + + ### RUN CACHE OF TRIED WINGATES. + if (grep /^$host$/, @wingateCache) { + push(@wingateNow, $host); # per run. + push(@wingateCache, $host); # cache per run. + } else { + &DEBUG("Already scanned $host. good."); + } + + my $interval = &getChanConfDefault('wingateInterval', 60, $chan); # seconds. + return if (defined $forked{'Wingate'}); + return if (time() - $wingaterun <= $interval); + return unless (scalar(keys %wingateToDo)); + + $wingaterun = time(); + + &Forker('Wingate', sub { &Wingate::Wingates(keys %wingateToDo); } ); + undef @wingateNow; +} + +### TODO: ?? +sub wingateWriteFile { + if (@_) { + &ScheduleThis(60, 'wingateWriteFile'); + return if ($_[0] eq '2'); # defer. + } + + return unless (scalar @wingateCache); + + my $file = "$bot_base_dir/$param{'ircUser'}.wingate"; + if ($bot_pid != $$) { + &DEBUG('wingateWriteFile: Reorganising!'); + + open(IN, $file); + while () { + chop; + push(@wingateNow, $_); + } + close IN; + + # very lame hack. + my %hash = map { $_ => 1 } @wingateNow; + @wingateNow = sort keys %hash; + } + + &DEBUG('wingateWF: writing...'); + open(OUT, ">$file"); + foreach (@wingateNow) { + print OUT "$_\n"; + } + close OUT; +} + +sub factoidCheck { + if (@_) { + &ScheduleThis(720, 'factoidCheck'); + return if ($_[0] eq '2'); # defer. + } + + my @list = &searchTable('factoids', 'factoid_key', 'factoid_key', " #DEL#"); + my $stale = &getChanConfDefault('factoidDeleteDelay', 14, $chan) *60*60*24; + if ($stale < 1) { + # disable it since it's 'illegal'. + return; + } + + my $time = time(); + + foreach (@list) { + my $age = &getFactInfo($_, 'modified_time'); + + if (!defined $age or $age !~ /^\d+$/) { + if (scalar @list > 50) { + if (!$cache{warnDel}) { + &WARN("list is over 50 (".scalar(@list)."... giving it a miss."); + $cache{warnDel} = 1; + last; + } + } + + &WARN("del factoid: old cruft (no time): $_"); + &delFactoid($_); + next; + } + + next unless ($time - $age > $stale); + + my $fix = $_; + $fix =~ s/ #DEL#$//g; + my $agestr = &Time2String($time - $age); + &status("safedel: Removing '$_' for good. [$agestr old]"); + + &delFactoid($_); + } +} + +sub dccStatus { + return unless (scalar keys %{ $dcc{CHAT} }); + + if (@_) { + &ScheduleThis(10, 'dccStatus'); + return if ($_[0] eq '2'); # defer. + } + + my $time = strftime("%H:%M", gmtime(time()) ); + + my $c; + foreach (keys %channels) { + my $c = $_; + my $users = keys %{ $channels{$c}{''} }; + my $chops = keys %{ $channels{$c}{o} }; + my $bans = keys %{ $channels{$c}{b} }; + + my $txt = "[$time] $c: $users members ($chops chops), $bans bans"; + foreach (keys %{ $dcc{'CHAT'} }) { + next unless (exists $channels{$c}{''}{lc $_}); + $conn->privmsg($dcc{'CHAT'}{$_}, $txt); + } + } +} + +sub scheduleList { + ### + # custom: + # a - time == now. + # b - weird time. + ### + + my $reply = "sched:"; + foreach (keys %{ $irc->{_queue}}) { + my $q = $_; + my $coderef = $irc->{_queue}->{$q}->[1]; + my $sched; + foreach (keys %sched) { + my $schedname = $_; + next unless defined(\&$schedname); + next unless ($coderef eq \&$schedname); + $sched = $schedname; + last; + } + + my $time = $irc->{_queue}->{$q}->[0] - time(); + + if (defined $sched) { + $reply = "$reply, $sched($q):" . &Time2String($time); + } else { + $reply = "$reply, NULL($q):" . &Time2String($time); + } + } + + &DEBUG("$reply"); +} + +sub mkBackup { + my($file, $time) = @_; + my $backup = 0; + + if (! -f $file) { + &VERB("mkB: file '$file' does not exist.",2); + return; + } + + my $age = 'New'; + if ( -e "$file~" ) { + $backup++ if ((stat $file)[9] - (stat "$file~")[9] > $time); + my $delta = time() - (stat "$file~")[9]; + $age = &Time2String($delta); + } else { + $backup++; + } + + return unless ($backup); + + ### TODO: do internal copying. + &status("Backup: $file ($age)"); + CORE::system("/bin/cp $file $file~"); +} + +1; diff --git a/src/Misc.pl b/src/Misc.pl new file mode 100644 index 0000000..e580fa0 --- /dev/null +++ b/src/Misc.pl @@ -0,0 +1,680 @@ +# +# Misc.pl: Miscellaneous stuff. +# Author: dms +# Version: 20000124 +# NOTE: Based on code by Kevin Lenzo & Patrick Cole (c) 1997 +# + +use strict; + +use vars qw(%file %mask %param %cmdstats %myModules); +use vars qw($msgType $who $bot_pid $nuh $shm $force_public_reply + $no_timehires $bot_data_dir $addrchar); + +sub help { + my $topic = shift; + my $file = $bot_data_dir."/infobot.help"; + my %help = (); + + # crude hack for performStrictReply() to work as expected. + $msgType = 'private' if ($msgType eq 'public'); + + if (!open(FILE, $file)) { + &ERROR("Failed reading help file ($file): $!"); + return; + } + + while (defined(my $help = )) { + $help =~ s/^[\# ].*//; + chomp $help; + next unless $help; + my ($key, $val) = split(/:/, $help, 2); + + $val =~ s/^\s+//; + $val =~ s/^D:/\002 Desc\002:/; + $val =~ s/^E:/\002Example\002:/; + $val =~ s/^N:/\002 NOTE\002:/; + $val =~ s/^U:/\002 Usage\002:/; + $val =~ s/##/$key/; + $val =~ s/__/\037/g; + $val =~ s/==/ /; + + $help{$key} = '' if (!exists $help{$key}); + $help{$key} .= $val."\n"; + } + close FILE; + + if (!defined $topic or $topic eq '') { + &msg($who, $help{'main'}); + + my $i = 0; + my @array; + my $count = scalar(keys %help); + my $reply; + foreach (sort keys %help) { + push(@array,$_); + $reply = scalar(@array) ." topics: ". + join("\002,\002 ", @array); + $i++; + + if (length $reply > 400 or $count == $i) { + &msg($who,$reply); + undef @array; + } + } + + return ''; + } + + $topic = &fixString(lc $topic); + + if (exists $help{$topic}) { + foreach (split /\n/, $help{$topic}) { + &performStrictReply($_); + } + } else { + &performStrictReply("no help on $topic. Use 'help' without arguments."); + } + + return ''; +} + +sub getPath { + my ($pathnfile) = @_; + + ### TODO: gotta hate an if statement. + if ($pathnfile =~ /(.*)\/(.*?)$/) { + return $1; + } else { + return "."; + } +} + +sub timeget { + if ($no_timehires) { # fallback. + return time(); + } else { # the real thing. + return [gettimeofday()]; + } +} + +sub timedelta { + my($start_time) = shift; + + if ($no_timehires) { # fallback. + return time() - $start_time; + } else { # the real thing. + return tv_interval ($start_time); + } +} + +### +### FORM Functions. +### + +### +# Usage; &formListReply($rand, $prefix, @list); +sub formListReply { + my($rand, $prefix, @list) = @_; + my $total = scalar @list; + my $maxshow = &getChanConfDefault('maxListReplyCount', 15, $chan); + my $maxlen = &getChanConfDefault('maxListReplyLength', 400, $chan); + my $reply; + + # remove irc overhead + $maxlen -= 30; + + # no results. + return $prefix ."returned no results." unless ($total); + + # random. + if ($rand) { + my @rand; + foreach (&makeRandom($total)) { + push(@rand, $list[$_]); + last if (scalar @rand == $maxshow); + } + if ($total > $maxshow) { + @list = sort @rand; + } else { + @list = @rand; + } + } elsif ($total > $maxshow) { + &status("formListReply: truncating list."); + + @list = @list[0..$maxshow-1]; + } + + # form the reply. + # FIXME: should grow and exit when full, not discard any that are oversize + while () { + $reply = $prefix ."(\002". scalar(@list). "\002"; + $reply .= " of \002$total\002" if ($total != scalar @list); + $reply .= "): " . join(" \002;;\002 ", @list) ."."; + + last if (length($reply) < $maxlen and scalar(@list) <= $maxshow); + last if (scalar(@list) == 1); + + pop @list; + } + + return $reply; +} + +### Intelligence joining of arrays. +# Usage: &IJoin(@array); +sub IJoin { + if (!scalar @_) { + return 'NULL'; + } elsif (scalar @_ == 1) { + return $_[0]; + } else { + return join(', ',@{_}[0..$#_-1]) . " and $_[$#_]"; + } +} + +##### +# Usage: &Time2String(seconds); +sub Time2String { + my ($time) = @_; + my $prefix = ''; + my (@s, @t); + + return 'NULL' if (!defined $time); + return $time if ($time !~ /\d+/); + + if ($time < 0) { + $time = - $time; + $prefix = "- "; + } + + $t[0] = int($time) % 60; + $t[1] = int($time / 60) % 60; + $t[2] = int($time / 3600) % 24; + $t[3] = int($time / 86400); + + push(@s, "$t[3]d") if ($t[3] != 0); + push(@s, "$t[2]h") if ($t[2] != 0); + push(@s, "$t[1]m") if ($t[1] != 0); + push(@s, "$t[0]s") if ($t[0] != 0 or !@s); + + my $retval = $prefix.join(' ', @s); + $retval =~ s/(\d+)/\002$1\002/g; + return $retval; +} + +### +### FIX Functions. +### + +# Usage: &fixFileList(@files); +sub fixFileList { + my @files = @_; + my %files; + + # generate a hash list. + foreach (@files) { + next unless /^(.*\/)(.*?)$/; + + $files{$1}{$2} = 1; + } + @files = (); # reuse the array. + + # sort the hash list appropriately. + foreach (sort keys %files) { + my $file = $_; + my @keys = sort keys %{ $files{$file} }; + my $i = scalar(@keys); + + if (scalar @keys > 3) { + pop @keys while (scalar @keys > 3); + push(@keys, "..."); + } + + if ($i > 1) { + $file .= "\002{\002". join("\002|\002", @keys) ."\002}\002"; + } else { + $file .= $keys[0]; + } + + push(@files,$file); + } + + return @files; +} + +# Usage: &fixString($str); +sub fixString { + my ($str, $level) = @_; + if (!defined $str) { + &WARN("fixString: str == NULL."); + return ''; + } + + for ($str) { + s/^\s+//; # remove start whitespaces. + s/\s+$//; # remove end whitespaces. + s/\s+/ /g; # remove excessive whitespaces. + + next unless (defined $level); + if (s/[\cA-\c_]//ig) { # remove control characters. + &DEBUG("stripped control chars"); + } + } + + return $str; +} + +# Usage: &fixPlural($str,$int); +sub fixPlural { + my ($str,$int) = @_; + + if (!defined $str) { + &WARN("fixPlural: str == NULL."); + return; + } + + if (!defined $int or $int =~ /^\D+$/) { + &WARN("fixPlural: int != defined or int"); + return $str; + } + + if ($str eq 'has') { + $str = 'have' if ($int > 1); + } elsif ($str eq 'is') { + $str = 'are' if ($int > 1); + } elsif ($str eq 'was') { + $str = 'were' if ($int > 1); + } elsif ($str eq 'this') { + $str = 'these' if ($int > 1); + } elsif ($str =~ /y$/) { + if ($int > 1) { + if ($str =~ /ey$/) { + $str .= 's'; # eg: 'money' => 'moneys'. + } else { + $str =~ s/y$/ies/; + } + } + } else { + $str .= 's' if ($int != 1); + } + + return $str; +} + +########## +### get commands. +### + +sub getRandomLineFromFile { + my($file) = @_; + + if (!open(IN, $file)) { + &WARN("gRLfF: could not open ($file): $!"); + return; + } + + my @lines = ; + close IN; + + if (!scalar @lines) { + &ERROR("GRLF: nothing loaded?"); + return; + } + + # could we use the filehandler instead and put it through getRandom? + while (my $line = &getRandom(@lines)) { + chop $line; + + next if ($line =~ /^\#/); + next if ($line =~ /^\s*$/); + + return $line; + } +} + +sub getLineFromFile { + my($file,$lineno) = @_; + + if (! -f $file) { + &ERROR("getLineFromFile: file '$file' does not exist."); + return 0; + } + + if (open(IN,$file)) { + my @lines = ; + close IN; + + if ($lineno > scalar @lines) { + &ERROR("getLineFromFile: lineno exceeds line count from file."); + return 0; + } + + my $line = $lines[$lineno-1]; + chop $line; + return $line; + } else { + &ERROR("gLFF: Could not open file ($file): $!"); + return 0; + } +} + +# Usage: &getRandom(@array); +sub getRandom { + my @array = @_; + + srand(); + return $array[int(rand(scalar @array))]; +} + +# Usage: &getRandomInt("30-60"); +sub getRandomInt { + my $str = $_[0]; + + if (!defined $str) { + &WARN("gRI: str == NULL."); + return; + } + + srand(); + + if ($str =~ /^(\d+(\.\d+)?)$/) { + my $i = $1; + my $fuzzy = int(rand 5); + if ($i < 10) { + return $i; + } + if (rand > 0.5) { + return ($i - $fuzzy)*60; + } else { + return ($i + $fuzzy)*60; + } + } elsif ($str =~ /^(\d+)-(\d+)$/) { + return ($2 - $1)*int(rand $1)*60; + } else { + return $str; # hope we're safe. + } + + &ERROR("getRandomInt: invalid arg '$str'."); + return 1800; +} + +########## +### Is commands. +### + +sub iseq { + my ($left,$right) = @_; + return 0 unless defined $right; + return 0 unless defined $left; + return 1 if ($left =~ /^\Q$right$/i); +} + +sub isne { + my $retval = &iseq(@_); + return 1 unless ($retval); + return 0; +} + +# Usage: &IsHostMatch($nuh); +sub IsHostMatch { + my ($thisnuh) = @_; + my (%this,%local); + + if ($nuh =~ /^(\S+)!(\S+)@(\S+)/) { + $local{'nick'} = lc $1; + $local{'user'} = lc $2; + $local{'host'} = &makeHostMask(lc $3); + } + + if (!defined $thisnuh) { + &WARN("IHM: thisnuh == NULL."); + return 0; + } elsif ($thisnuh =~ /^(\S+)!(\S+)@(\S+)/) { + $this{'nick'} = lc $1; + $this{'user'} = lc $2; + $this{'host'} = &makeHostMask(lc $3); + } else { + &WARN("IHM: thisnuh is invalid '$thisnuh'."); + return 1 if ($thisnuh eq ''); + return 0; + } + + # auth if 1) user and host match 2) user and nick match. + # this may change in the future. + + if ($this{'user'} =~ /^\Q$local{'user'}\E$/i) { + return 2 if ($this{'host'} eq $local{'host'}); + return 1 if ($this{'nick'} eq $local{'nick'}); + } + return 0; +} + +#### +# Usage: &isStale($file, $age); +sub isStale { + my ($file, $age) = @_; + + if (!defined $age) { + &WARN("isStale: age == NULL."); + return 1; + } + + if (!defined $file) { + &WARN("isStale: file == NULL."); + return 1; + } + + &DEBUG("!exist $file") if (! -f $file); + + return 1 unless ( -f $file); + if ($file =~ /idx/) { + my $age2 = time() - (stat($file))[9]; + &VERB("stale: $age2. (". &Time2String($age2) .")",2); + } + $age *= 60*60*24 if ($age >= 0 and $age < 30); + + return 1 if (time() - (stat($file))[9] > $age); + return 0; +} + +sub isFileUpdated { + my ($file, $time) = @_; + + if (! -f $file) { + return 1; + } + + my $time_file = (stat $file)[9]; + + if ($time <= $time_file) { + return 0; + } else { + return 1; + } +} + +########## +### make commands. +### + +# Usage: &makeHostMask($host); +sub makeHostMask { + my ($host) = @_; + my $nu = ''; + + if ($host =~ s/^(\S+!\S+\@)//) { + &DEBUG("mHM: detected nick!user\@ for host arg; fixing"); + &DEBUG("nu => $nu"); + $nu = $1; + } + + if ($host =~ /^$mask{ip}$/) { + return $nu."$1.$2.$3.*"; + } + + my @array = split(/\./, $host); + return $nu.$host if (scalar @array <= 3); + return $nu."*.".join('.',@{array}[1..$#array]); +} + +# Usage: &makeRandom(int); +sub makeRandom { + my ($max) = @_; + my @retval; + my %done; + + if ($max =~ /^\D+$/) { + &ERROR("makeRandom: arg ($max) is not integer."); + return 0; + } + + if ($max < 1) { + &ERROR("makeRandom: arg ($max) is not positive."); + return 0; + } + + srand(); + while (scalar keys %done < $max) { + my $rand = int(rand $max); + next if (exists $done{$rand}); + + push(@retval,$rand); + $done{$rand} = 1; + } + + return @retval; +} + +sub checkMsgType { + my ($reply) = @_; + return unless (&IsParam('minLengthBeforePrivate')); + return if ($force_public_reply); + + if (length $reply > $param{'minLengthBeforePrivate'}) { + &status("Reply: len reply > minLBP ($param{'minLengthBeforePrivate'}); msgType now private."); + $msgType = 'private'; + } +} + +### +### Valid. +### + +# Usage: &validExec($string); +sub validExec { + my ($str) = @_; + + if ($str =~ /[\`\'\"\|]/) { # invalid. + return 0; + } else { # valid. + return 1; + } +} + +# Usage: &hasProfanity($string); +sub hasProfanity { + my ($string) = @_; + my $profanity = 1; + + for (lc $string) { + /fuck/ and last; + /dick|dildo/ and last; + /shit/ and last; + /pussy|[ck]unt/ and last; + /wh[0o]re|bitch|slut/ and last; + + $profanity = 0; + } + + return $profanity; +} + +sub IsChanConfOrWarn { + my ($param) = @_; + + if (&IsChanConf($param) > 0) { + return 1; + } else { + ### TODO: specific reason why it failed. + &msg($who, "unfortunately, \002$param\002 is disabled in my configuration") unless ($addrchar); + return 0; + } +} + +sub Forker { + my ($label, $code) = @_; + my $pid; + + &shmFlush(); + &VERB("double fork detected; not forking.",2) if ($$ != $bot_pid); + + if (&IsParam('forking') and $$ == $bot_pid) { + return unless &addForked($label); + + $SIG{CHLD} = 'IGNORE'; + $pid = eval { fork() }; + return if $pid; # parent does nothing + + select(undef, undef, undef, 0.2); +# &status("fork starting for '$label', PID == $$."); + &status("--- fork starting for '$label', PID == $$, bot_pid == $bot_pid ---"); + &shmWrite($shm,"SET FORKPID $label $$"); + + sleep 1; + } + + ### TODO: use AUTOLOAD + ### very lame hack. + if ($label !~ /-/ and !&loadMyModule($label)) { + &DEBUG("Forker: failed?"); + &delForked($label); + } + + if (defined $code) { + $code->(); # weird, hey? + } else { + &WARN("Forker: code not defined!"); + } + + &delForked($label); +} + +sub closePID { + return 1 unless (exists $file{PID}); + return 1 unless ( -f $file{PID}); + return 1 if (unlink $file{PID}); + return 0 if ( -f $file{PID}); +} + +sub mkcrypt { + my($str) = @_; + my $salt = join '',('.','/',0..9,'A'..'Z','a'..'z')[rand 64, rand 64]; + + return crypt($str, $salt); +} + +sub closeStats { + return unless (&getChanConfList('ircTextCounters')); + + foreach (keys %cmdstats) { + my $type = $_; + my $i = &sqlSelect('stats', 'counter', { + nick => $type, + type => 'cmdstats', + } ); + my $z = 0; + $z++ unless ($i); + + $i += $cmdstats{$type}; + + + &sqlSet('stats', {'nick' => $type}, { + type => 'cmdstats', + 'time' => time(), + counter => $i, + } ); + } +} + +1; diff --git a/src/Modules/BZFlag.pl b/src/Modules/BZFlag.pl new file mode 100755 index 0000000..69672c2 --- /dev/null +++ b/src/Modules/BZFlag.pl @@ -0,0 +1,360 @@ +#!/usr/bin/perl +# +# BZFlag +# Copyright (c) 1993 - 2002 Tim Riker +# +# This package is free software; you can redistribute it and/or +# modify it under the terms of the license found in the file +# named LICENSE that should have accompanied this file. +# +# THIS PACKAGE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR +# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED +# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. + +package BZFlag; +use strict; +use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK); + +my $no_BZFlag; + +BEGIN { + $no_BZFlag = 0; + eval "use Socket"; + eval "use LWP::UserAgent"; + $no_BZFlag++ if ($@); +} + +sub BZFlag { + my ($message) = @_; + my ($retval); + if ($no_BZFlag) { + &::status("BZFlag module requires Socket."); + return 'BZFlag module not active'; + } + if ($message =~ /^bzfquery\s+([^:]*)(?::([0-9]*))?$/xi) { + $retval = &query($1,$2); + } elsif ($message =~ /^bzflist$/xi) { + $retval = &list(); + } else { + $retval = "BZFlag: unhandled command \"$message\""; + } + &::performStrictReply($retval); +} + +sub list { + my ($response); + my $ua = new LWP::UserAgent; + $ua->proxy('http', $::param{'httpProxy'}) if (&::IsParam('httpProxy')); + + $ua->timeout(5); + + my $req = HTTP::Request->new('GET', 'http://db.bzflag.org/db/?action=LIST'); + my $res = $ua->request($req); + my %servers; + my $totalServers = 0; + for my $line (split("\n",$res->content)) { + my ($serverport, $version, $flags, $ip, $comments) = split(" ",$line,5); + # not "(A4)18" to handle old dumb perl + my ($style, $maxShots, $shakeWins, $shakeTimeout, $maxPlayerScore, $maxTeamScore, $maxTime, + $maxPlayers, $rogueSize, $rogueMax, $redSize, $redMax, $greenSize, $greenMax, + $blueSize, $blueMax, $purpleSize, $purpleMax, $observerSize, $observerMax) = + unpack('A4A4A4A4A4A4A4A2A2A2A2A2A2A2A2A2A2A2A2A2', $flags); + my $playerSize = hex($rogueSize) + hex($redSize) + hex($greenSize) + + hex($blueSize) + hex($purpleSize) + hex($observerSize); + $servers{$serverport} = $playerSize; + $servers{$version} += $playerSize; + $servers{'PLAYERS'} += $playerSize; + $totalServers += 1; + } + $response .= "s=$totalServers"; + foreach my $key (sort {$servers{$b} <=> $servers{$a}} (keys(%servers))) { + if ($servers{$key} > 0) { + $response .= " $key($servers{$key})"; + } + } + &::performStrictReply($response); + return; +} + +sub list17 { + my ($response); + my $ua = new LWP::UserAgent; + $ua->proxy('http', $::param{'httpProxy'}) if (&::IsParam('httpProxy')); + + $ua->timeout(5); + + my $req = HTTP::Request->new('GET', 'http://list.bzflag.org:5156/'); + my $res = $ua->request($req); + my %servers; + my $totalServers = 0; + my $totalPlayers = 0; + for my $line (split("\n",$res->content)) { + my ($serverport, $version, $flags, $ip, $comments) = split(" ",$line,5); + # not "(A4)18" to handle old dumb perl + my ($style,$maxPlayers,$maxShots, + $rogueSize,$redSize,$greenSize,$blueSize,$purpleSize, + $rogueMax,$redMax,$greenMax,$blueMax,$purpleMax, + $shakeWins,$shakeTimeout, + $maxPlayerScore,$maxTeamScore,$maxTime) = + unpack('A4A4A4A4A4A4A4A4A4A4A4A4A4A4A4A4A4A4', $flags); + my $playerSize = hex($rogueSize) + hex($redSize) + hex($greenSize) + + hex($blueSize) + hex($purpleSize); + $servers{$serverport} = $playerSize; + $totalServers += 1; + $totalPlayers += $playerSize; + } + $response .= "s=$totalServers p=$totalPlayers"; + foreach my $key (sort {$servers{$b} <=> $servers{$a}} (keys(%servers))) { + if ($servers{$key} > 0) { + $response .= " $key($servers{$key})"; + } + } + &::performStrictReply($response); + return; +} + +sub querytext { + my ($servernameport) = @_; + my ($servername,$port) = split(":",$servernameport); + if ($no_BZFlag) { + &::status("BZFlag module requires Socket."); + return 'BZFlag module not active'; + } + #my @teamName = ('Rogue', 'Red', 'Green', 'Blue', 'Purple', 'Observer', 'Rabbit'); + my @teamName = ('X', 'R', 'G', 'B', 'P', 'O', 'K'); + my ($message, $server, $response); + $port = 5154 unless $port; + + # socket define + my $sockaddr = 'S n a4 x8'; + + # port to port number + my ($name,$aliases,$proto) = getprotobyname('tcp'); + ($name,$aliases,$port) = getservbyname($port,'tcp') unless $port =~ /^\d+$/; + + # get server address + my ($type,$len,$serveraddr); + ($name,$aliases,$type,$len,$serveraddr) = gethostbyname($servername); + $server = pack($sockaddr, AF_INET, $port, $serveraddr); + + # connect + # TODO wrap this with a 5 second alarm() + return 'socket() error' unless socket(S1, AF_INET, SOCK_STREAM, $proto); + return "could not connect to $servername:$port" unless connect(S1, $server); + + # don't buffer + select(S1); $| = 1; select(STDOUT); + + # get hello + my $buffer; + return 'read error' unless read(S1, $buffer, 8) == 8; + + # parse reply + my ($magic,$major,$minor,$something,$revision) = unpack("a4 a1 a1 a1 a1", $buffer); + my ($version) = $magic . $major . $minor . $something . $revision; + + # quit if version isn't valid + return 'not a bzflag server' if ($magic ne 'BZFS'); + $response .= "$major$minor$something$revision "; + # check version + if ($version eq 'BZFS0026') { + # 1.11.x handled here + return 'read error' unless read(S1, $buffer, 1) == 1; + my ($id) = unpack('C', $buffer); + return "rejected by server" if ($id == 255); + + # send game request + print S1 pack('n2', 0, 0x7167); + + # get reply + my $nbytes = read(S1, $buffer, 4); + my ($infolen, $infocode) = unpack('n2', $buffer); + if ($infocode == 0x6774) { + # read and ignore MsgGameTime from new servers + $nbytes = read(S1, $buffer, 8); + $nbytes = read(S1, $buffer, 4); + ($infolen, $infocode) = unpack('n2', $buffer); + } + $nbytes = read(S1, $buffer, 42); + if ($nbytes != 42) { + return "Error: read $nbytes bytes, expecting 46: $^E\n"; + } + + my ($style,$maxPlayers,$maxShots, + $rogueSize,$redSize,$greenSize,$blueSize,$purpleSize,$observerSize, + $rogueMax,$redMax,$greenMax,$blueMax,$purpleMax,$observerMax, + $shakeWins,$shakeTimeout, + $maxPlayerScore,$maxTeamScore,$maxTime,$timeElapsed) = unpack('n23', $buffer); + return "bad server data $infocode" unless $infocode == 0x7167; + + # send players request + print S1 pack('n2', 0, 0x7170); + + # get number of teams and players we'll be receiving + return 'count read error' unless read(S1, $buffer, 8) == 8; + my ($countlen,$countcode,$numTeams,$numPlayers) = unpack('n4', $buffer); + + # get the teams + return 'bad count data' unless $countcode == 0x7170; + return 'count read error' unless read(S1, $buffer, 5) == 5; + ($countlen,$countcode,$numTeams) = unpack("n n C", $buffer); + for (1..$numTeams) { + return 'team read error' unless read(S1, $buffer, 8) == 8; + my ($team,$size,$won,$lost) = unpack('n4', $buffer); + if ($size > 0) { + my $score = $won - $lost; + $response .= "$teamName[$team]:$score($won-$lost) "; + } + } + + # get the players + for (1..$numPlayers) { + last unless read(S1, $buffer, 175) == 175; + my ($playerlen,$playercode,$pID,$type,$team,$won,$lost,$tks,$sign,$email) = + unpack('n2Cn5A32A128', $buffer); + #my ($playerlen,$playercode,$pAddr,$pPort,$pNum,$type,$team,$won,$lost,$sign,$email) = + # unpack("n2Nn2 n4A32A128", $buffer); + return 'bad player data' unless $playercode == 0x6170; + my $score = $won - $lost; + $response .= " $sign($teamName[$team]"; + $response .= ":$email" if ($email); + $response .= ")$score($won-$lost)"; + } + $response .= "No Players" if ($numPlayers < 1); + + # close socket + } elsif ($major == 1 && $minor == 9) { + # 1.10.x handled here + $revision = $something * 10 + $revision; + return 'read error' unless read(S1, $buffer, 1) == 1; + my ($id) = unpack('C', $buffer); + + # send game request + print S1 pack('n2', 0, 0x7167); + + # FIXME the packets are wrong from here down + # get reply + return 'server read error' unless read(S1, $buffer, 40) == 40; + my ($infolen,$infocode,$style,$maxPlayers,$maxShots, + $rogueSize,$redSize,$greenSize,$blueSize,$purpleSize, + $rogueMax,$redMax,$greenMax,$blueMax,$purpleMax, + $shakeWins,$shakeTimeout, + $maxPlayerScore,$maxTeamScore,$maxTime) = unpack('n20', $buffer); + return 'bad server data' unless $infocode == 0x7167; + + # send players request + print S1 pack('n2', 0, 0x7170); + + # get number of teams and players we'll be receiving + return 'count read error' unless read(S1, $buffer, 8) == 8; + my ($countlen,$countcode,$numTeams,$numPlayers) = unpack('n4', $buffer); + + # get the teams + return 'bad count data' unless $countcode == 0x7170; + return 'count read error' unless read(S1, $buffer, 5) == 5; + ($countlen,$countcode,$numTeams) = unpack("n n C", $buffer); + for (1..$numTeams) { + return 'team read error' unless read(S1, $buffer, 8) == 8; + my ($team,$size,$won,$lost) = unpack('n4', $buffer); + if ($size > 0) { + my $score = $won - $lost; + $response .= "$teamName[$team]:$score($won-$lost) "; + } + } + + # get the players + for (1..$numPlayers) { + last unless read(S1, $buffer, 175) == 175; + my ($playerlen,$playercode,$pID,$type,$team,$won,$lost,$tks,$sign,$email) = + unpack('n2Cn5A32A128', $buffer); + #my ($playerlen,$playercode,$pAddr,$pPort,$pNum,$type,$team,$won,$lost,$sign,$email) = + # unpack("n2Nn2 n4A32A128", $buffer); + return 'bad player data' unless $playercode == 0x6170; + my $score = $won - $lost; + $response .= " $sign($teamName[$team]"; + $response .= ":$email" if ($email); + $response .= ")$score($won-$lost)"; + } + $response .= "No Players" if ($numPlayers < 1); + + # close socket + close(S1); + } elsif ($major == 1 && $minor == 0 && $something == 7) { + # 1.7* versions handled here + # old servers send a reconnect port number + return 'read error' unless read(S1, $buffer, 2) == 2; + my ($reconnect) = unpack('n', $buffer); + $minor = $minor * 10 + $something; + # quit if rejected + return 'rejected by server' if ($reconnect == 0); + + # reconnect on new port + $server = pack($sockaddr, AF_INET, $reconnect, $serveraddr); + return 'socket() error on reconnect' unless socket(S, AF_INET, SOCK_STREAM, $proto); + return "could not reconnect to $servername:$reconnect" unless connect(S, $server); + select(S); $| = 1; select(STDOUT); + + # close first socket + close(S1); + + # send game request + print S pack('n2', 0, 0x7167); + + # get reply + return 'server read error' unless read(S, $buffer, 40) == 40; + my ($infolen,$infocode,$style,$maxPlayers,$maxShots, + $rogueSize,$redSize,$greenSize,$blueSize,$purpleSize, + $rogueMax,$redMax,$greenMax,$blueMax,$purpleMax, + $shakeWins,$shakeTimeout, + $maxPlayerScore,$maxTeamScore,$maxTime) = unpack('n20', $buffer); + return 'bad server data' unless $infocode == 0x7167; + + # send players request + print S pack('n2', 0, 0x7170); + + # get number of teams and players we'll be receiving + return 'count read error' unless read(S, $buffer, 8) == 8; + my ($countlen,$countcode,$numTeams,$numPlayers) = unpack('n4', $buffer); + return 'bad count data' unless $countcode == 0x7170; + + # get the teams + for (1..$numTeams) { + return 'team read error' unless read(S, $buffer, 14) == 14; + my ($teamlen,$teamcode,$team,$size,$aSize,$won,$lost) = unpack('n7', $buffer); + return 'bad team data' unless $teamcode == 0x7475; + if ($size > 0) { + my $score = $won - $lost; + $response .= "$teamName[$team]:$score($won-$lost) "; + } + } + + # get the players + for (1..$numPlayers) { + last unless read(S, $buffer, 180) == 180; + my ($playerlen,$playercode,$pAddr,$pPort,$pNum,$type,$team,$won,$lost,$sign,$email) = + unpack("n2Nn2 n4A32A128", $buffer); + return 'bad player data' unless $playercode == 0x6170; + my $score = $won - $lost; + $response .= " $sign($teamName[$team]"; + $response .= ":$email" if ($email); + $response .= ")$score($won-$lost)"; + } + $response .= "No Players" if ($numPlayers <= 1); + + # close socket + close(S); + } else { + $response = "incompatible version: $version"; + } + + return $response; +} + +sub query { + my ($servernameport) = @_; + &::performStrictReply(&querytext($servernameport)); + return; +} + +1; +# vim: ts=2 sw=2 diff --git a/src/Modules/Debian.pl b/src/Modules/Debian.pl new file mode 100644 index 0000000..963b58a --- /dev/null +++ b/src/Modules/Debian.pl @@ -0,0 +1,1148 @@ +# +# Debian.pl: Frontend to debian contents and packages files +# Author: dms +# Version: v0.8 (20000918) +# Created: 20000106 +# + +package Debian; + +use strict; +no strict 'refs'; # FIXME: dstats aborts if set + +my $announce = 0; +my $defaultdist = 'sid'; +my $refresh = &::getChanConfDefault('debianRefreshInterval', 7, $::chan) * 60 * 60 * 24; +my $debug = 0; +my $debian_dir = $::bot_state_dir . '/debian'; +my $country = 'nl'; # well .config it yourself then. ;-) +my $protocol = 'http'; +# EDIT THIS (i386, amd64, powerpc, [etc.]): +my $arch = "$arch"; + +# format: "alias=real". +my %dists = ( + 'unstable' => 'sid', + 'testing' => 'lenny', + 'stable' => 'etch', + 'oldstable' => 'sarge', + 'incoming' => 'incoming', +); + +my %urlcontents = ( + "Contents-##DIST-$arch.gz" => + "$protocol://ftp.$country.debian.org". + "/debian/dists/##DIST/Contents-$arch.gz", + "Contents-##DIST-$arch-non-US.gz" => + "$protocol://non-us.debian.org". + "/debian-non-US/dists/##DIST/non-US/Contents-$arch.gz", +); + +my %urlpackages = ( + "Packages-##DIST-main-$arch.gz" => + "$protocol://ftp.$country.debian.org". + "/debian/dists/##DIST/main/binary-$arch/Packages.gz", + "Packages-##DIST-contrib-$arch.gz" => + "$protocol://ftp.$country.debian.org". + "/debian/dists/##DIST/contrib/binary-$arch/Packages.gz", + "Packages-##DIST-non-free-$arch.gz" => + "$protocol://ftp.$country.debian.org". + "/debian/dists/##DIST/non-free/binary-$arch/Packages.gz", +); + +##################### +### COMMON FUNCTION.... +####################### + +#### +# Usage: &DebianDownload($dist, %hash); +sub DebianDownload { + my ($dist, %urls) = @_; + my $bad = 0; + my $good = 0; + + if (! -d $debian_dir) { + &::status("Debian: creating debian dir."); + mkdir($debian_dir, 0755); + } + + # fe dists. + # Download the files. + my $file; + foreach $file (keys %urls) { + my $url = $urls{$file}; + $url =~ s/##DIST/$dist/g; + $file =~ s/##DIST/$dist/g; + my $update = 0; + + if ( -f $file ) { + my $last_refresh = (stat $file)[9]; + $update++ if (time() - $last_refresh > $refresh); + } else { + $update++; + } + + next unless ($update); + + &::DEBUG("announce == $announce.") if ($debug); + if ($good + $bad == 0 and !$announce) { + &::status("Debian: Downloading files for '$dist'."); + &::msg($::who, "Updating debian files... please wait."); + $announce++; + } + + if (exists $::debian{$url}) { + &::DEBUG("2: ".(time - $::debian{$url})." <= $refresh") if ($debug); + next if (time() - $::debian{$url} <= $refresh); + &::DEBUG("stale for url $url; updating!") if ($debug); + } + + if ($url =~ /^ftp:\/\/(.*?)\/(\S+)\/(\S+)$/) { + my ($host,$path,$thisfile) = ($1,$2,$3); + + if (!&::ftpGet($host,$path,$thisfile,$file)) { + &::WARN("deb: down: $file == BAD."); + $bad++; + next; + } + + } elsif ($url =~ /^http:\/\/\S+\/\S+$/) { + + if (!&::getURLAsFile($url,$file)) { + &::WARN("deb: down: http: $file == BAD."); + $bad++; + next; + } + + } else { + &::ERROR("Debian: invalid format of url => ($url)."); + $bad++; + next; + } + + if (! -f $file) { + &::WARN("deb: down: http: !file"); + $bad++; + next; + } + +# my $exit = system("/bin/gzip -t $file"); +# if ($exit) { +# &::WARN("deb: $file is corrupted ($exit) :/"); +# unlink $file; +# next; +# } + + &::DEBUG("deb: download: good.") if ($debug); + $good++; + } + + # ok... lets just run this. + &::miscCheck() if (&::whatInterface() =~ /IRC/); + + if ($good) { + &generateIndex($dist); + return 1; + } else { + return -1 unless ($bad); # no download. + &::DEBUG("DD: !good and bad($bad). :("); + return 0; + } +} + +########################### +# DEBIAN CONTENTS SEARCH FUNCTIONS. +######## + +#### +# Usage: &searchContents($query); +sub searchContents { + my ($dist, $query) = &getDistroFromStr($_[0]); + &::status("Debian: Contents search for '$query' in '$dist'."); + my $dccsend = 0; + + $dccsend++ if ($query =~ s/^dcc\s+//i); + + $query =~ s/\\([\^\$])/$1/g; # hrm? + $query =~ s/^\s+|\s+$//g; + + if (!&::validExec($query)) { + &::msg($::who, 'search string looks fuzzy.'); + return; + } + + if ($dist eq 'incoming') { # nothing yet. + &::DEBUG('sC: dist = "incoming". no contents yet.'); + return; + } else { + my %urls = &fixDist($dist, %urlcontents); + # download contents file. + &::DEBUG('deb: download 1.') if ($debug); + if (!&DebianDownload($dist, %urls)) { + &::WARN('Debian: could not download files.'); + } + } + + # start of search. + my $start_time = &::timeget(); + + my $found = 0; + my $front = 0; + my %contents; + my $grepRE; + ### TODO: search properly if /usr/bin/blah is done. + if ($query =~ s/\$$//) { + &::DEBUG("deb: search-regex found.") if ($debug); + $grepRE = "$query\[ \t]"; + } elsif ($query =~ s/^\^//) { + &::DEBUG("deb: front marker regex found.") if ($debug); + $front = 1; + $grepRE = $query; + } else { + $grepRE = "$query*\[ \t]"; + } + + # fix up grepRE for "*". + $grepRE =~ s/\*/.*/g; + + my @files; + foreach (keys %urlcontents) { + s/##DIST/$dist/g; + + next unless ( -f "$debian_dir/$_" ); + push(@files, "$debian_dir/$_"); + } + + if (!scalar @files) { + &::ERROR("sC: no files?"); + &::msg($::who, "failed."); + return; + } + + my $files = join(' ', @files); + + my $regex = $query; + $regex =~ s/\./\\./g; + $regex =~ s/\*/\\S*/g; + $regex =~ s/\?/./g; + + open(IN,"zegrep -h '$grepRE' $files |"); + # wonderful abuse of if, last, next, return, and, unless ;) + while () { + last if ($found > 100); + + next unless (/^\.?\/?(.*?)[\t\s]+(\S+)\n$/); + my ($file,$package) = ("/".$1,$2); + + if ($query =~ /[\/\*\\]/) { + next unless (eval { $file =~ /$regex/ }); + return unless &checkEval($@); + } else { + my ($basename) = $file =~ /^.*\/(.*)$/; + next unless (eval { $basename =~ /$regex/ }); + return unless &checkEval($@); + } + next if ($query !~ /\.\d\.gz/ and $file =~ /\/man\//); + next if ($front and eval { $file !~ /^\/$query/ }); + return unless &checkEval($@); + + $contents{$package}{$file} = 1; + $found++; + } + close IN; + + my $pkg; + + ### send results with dcc. + if ($dccsend) { + if (exists $::dcc{'SEND'}{$::who}) { + &::msg($::who, "DCC already active!"); + return; + } + + if (!scalar %contents) { + &::msg($::who,"search returned no results."); + return; + } + + my $file = "$::param{tempDir}/$::who.txt"; + if (!open OUT, ">$file") { + &::ERROR("Debian: cannot write file for dcc send."); + return; + } + + foreach $pkg (keys %contents) { + foreach (keys %{ $contents{$pkg} }) { + # TODO: correct padding. + print OUT "$_\t\t\t$pkg\n"; + } + } + close OUT; + + &::shmWrite($::shm, "DCC SEND $::who $file"); + + return; + } + + &::status("Debian: $found contents results found."); + + my @list; + foreach $pkg (keys %contents) { + my @tmplist = &::fixFileList(keys %{ $contents{$pkg} }); + my @sublist = sort { length $a <=> length $b } @tmplist; + + pop @sublist while (scalar @sublist > 3); + + $pkg =~ s/\,/\037\,\037/g; # underline ','. + push(@list, "(". join(', ',@sublist) .") in $pkg"); + } + # sort the total list from shortest to longest... + @list = sort { length $a <=> length $b } @list; + + # show how long it took. + my $delta_time = &::timedelta($start_time); + &::status(sprintf("Debian: %.02f sec to complete query.", $delta_time)) if ($delta_time > 0); + + my $prefix = "Debian Search of '$query' "; + if (scalar @list) { # @list. + &::performStrictReply( &::formListReply(0, $prefix, @list) ); + return; + } + + # !@list. + &::DEBUG("deb: ok, !\@list, searching desc for '$query'.") if ($debug); + @list = &searchDesc($query); + + if (!scalar @list) { + my $prefix = "Debian Package/File/Desc Search of '$query' "; + &::performStrictReply( &::formListReply(0, $prefix, ) ); + + } elsif (scalar @list == 1) { # list = 1. + &::DEBUG("deb: list == 1; showing package info of '$list[0]'."); + &infoPackages("info", $list[0]); + + } else { # list > 1. + my $prefix = "Debian Desc Search of '$query' "; + &::performStrictReply( &::formListReply(0, $prefix, @list) ); + } +} + +#### +# Usage: &searchAuthor($query); +sub searchAuthor { + my ($dist, $query) = &getDistroFromStr($_[0]); + &::DEBUG("deb: searchAuthor: dist => '$dist', query => '$query'.") if ($debug); + $query =~ s/^\s+|\s+$//g; + + # start of search. + my $start_time = &::timeget(); + &::status("Debian: starting author search."); + + my $files; + my ($bad,$good) = (0,0); + my %urls = %urlpackages; + + foreach (keys %urlpackages) { + s/##DIST/$dist/g; + + if (! -f "$debian_dir/$_" ) { + $bad++; + next; + } + + $good++; + $files .= " ".$_; + } + + &::DEBUG("deb: good = $good, bad = $bad...") if ($debug); + + if ($good == 0 and $bad != 0) { + my %urls = &fixDist($dist, %urlpackages); + &::DEBUG("deb: download 2."); + + if (!&DebianDownload($dist, %urls)) { + &::ERROR("Debian(sA): could not download files."); + return; + } + } + + my (%maint, %pkg, $package); + open(IN,"zegrep -h '^Package|^Maintainer' $files |"); + while () { + if (/^Package: (\S+)$/) { + $package = $1; + + } elsif (/^Maintainer: (.*) \<(\S+)\>$/) { + my($name,$email) = ($1,$2); + if ($package eq "") { + &::DEBUG("deb: sA: package == NULL."); + next; + } + $maint{$name}{$email} = 1; + $pkg{$name}{$package} = 1; + $package = ""; + + } else { + chop; + &::WARN("debian: invalid line: '$_' (1)."); + } + } + close IN; + + my %hash; + # TODO: can we use 'map' here? + foreach (grep /\Q$query\E/i, keys %maint) { + $hash{$_} = 1; + } + + # TODO: should we only search email if '@' is used? + if (scalar keys %hash < 15) { + my $name; + + foreach $name (keys %maint) { + my $email; + + foreach $email (keys %{ $maint{$name} }) { + next unless ($email =~ /\Q$query\E/i); + next if (exists $hash{$name}); + $hash{$name} = 1; + } + } + } + + my @list = keys %hash; + if (scalar @list != 1) { + my $prefix = "Debian Author Search of '$query' "; + &::performStrictReply( &::formListReply(0, $prefix, @list) ); + return 1; + } + + &::DEBUG("deb: showing all packages by '$list[0]'...") if ($debug); + + my @pkg = sort keys %{ $pkg{$list[0]} }; + + # show how long it took. + my $delta_time = &::timedelta($start_time); + &::status(sprintf("Debian: %.02f sec to complete query.", $delta_time)) if ($delta_time > 0); + + my $email = join(', ', keys %{ $maint{$list[0]} }); + my $prefix = "Debian Packages by $list[0] \002<\002$email\002>\002 "; + &::performStrictReply( &::formListReply(0, $prefix, @pkg) ); +} + +#### +# Usage: &searchDesc($query); +sub searchDesc { + my ($dist, $query) = &getDistroFromStr($_[0]); + &::DEBUG("deb: searchDesc: dist => '$dist', query => '$query'.") if ($debug); + $query =~ s/^\s+|\s+$//g; + + # start of search. + my $start_time = &::timeget(); + &::status("Debian: starting desc search."); + + my $files; + my ($bad,$good) = (0,0); + my %urls = %urlpackages; + + foreach (keys %urlpackages) { + s/##DIST/$dist/g; + + if (! -f "$debian_dir/$_" ) { + $bad++; + next; + } + + $good++; + $files .= " $debian_dir/$_"; + } + + &::DEBUG("deb(2): good = $good, bad = $bad...") if ($debug); + + if ($good == 0 and $bad != 0) { + my %urls = &fixDist($dist, %urlpackages); + &::DEBUG("deb: download 2c.") if ($debug); + + if (!&DebianDownload($dist, %urls)) { + &::ERROR("deb: sD: could not download files."); + return; + } + } + + my $regex = $query; + $regex =~ s/\./\\./g; + $regex =~ s/\*/\\S*/g; + $regex =~ s/\?/./g; + + my (%desc, $package); + open(IN,"zegrep -h '^Package|^Description' $files |"); + while () { + if (/^Package: (\S+)$/) { + $package = $1; + } elsif (/^Description: (.*)$/) { + my $desc = $1; + next unless (eval { $desc =~ /$regex/i }); + return unless &checkEval($@); + + if ($package eq "") { + &::WARN("sD: package == NULL?"); + next; + } + + $desc{$package} = $desc; + $package = ""; + + } else { + chop; + &::WARN("debian: invalid line: '$_'. (2)"); + } + } + close IN; + + # show how long it took. + my $delta_time = &::timedelta($start_time); + &::status(sprintf("Debian: %.02f sec to complete query.", $delta_time)) if ($delta_time > 0); + + return keys %desc; +} + +#### +# Usage: &generateIncoming(); +sub generateIncoming { + my $pkgfile = $debian_dir."/Packages-incoming"; + my $idxfile = $pkgfile.".idx"; + my $stale = 0; + $stale++ if (&::isStale($pkgfile.".gz", $refresh)); + $stale++ if (&::isStale($idxfile, $refresh)); + &::DEBUG("deb: gI: stale => '$stale'.") if ($debug); + return 0 unless ($stale); + + ### STATIC URL. + my %ftp = &::ftpList("llug.sep.bnl.gov", "/pub/debian/Incoming/"); + + if (!open PKG, ">$pkgfile") { + &::ERROR("cannot write to pkg $pkgfile."); + return 0; + } + if (!open IDX, ">$idxfile") { + &::ERROR("cannot write to idx $idxfile."); + return 0; + } + + print IDX "*$pkgfile.gz\n"; + my $file; + foreach $file (sort keys %ftp) { + next unless ($file =~ /deb$/); + + if ($file =~ /^(\S+)\_(\S+)\_(\S+)\.deb$/) { + print IDX "$1\n"; + print PKG "Package: $1\n"; + print PKG "Version: $2\n"; + print PKG "Architecture: ", (defined $4) ? $4 : "all", "\n"; + } + print PKG "Filename: $file\n"; + print PKG "Size: $ftp{$file}\n"; + print PKG "\n"; + } + close IDX; + close PKG; + + system("gzip -9fv $pkgfile"); # lame fix. + + &::status("Debian: generateIncoming() complete."); +} + + +############################## +# DEBIAN PACKAGE INFO FUNCTIONS. +######### + +# Usage: &getPackageInfo($query,$file); +sub getPackageInfo { + my ($package, $file) = @_; + + if (! -f $file) { + &::status("gPI: file $file does not exist?"); + return 'NULL'; + } + + my $found = 0; + my (%pkg, $pkg); + + open(IN, "/bin/zcat $file 2>&1 |"); + + my $done = 0; + while (!eof IN) { + $_ = ; + + next if (/^ \S+/); # package long description. + + # package line. + if (/^Package: (.*)\n$/) { + $pkg = $1; + if ($pkg =~ /^\Q$package\E$/i) { + $found++; # we can use pkg{'package'} instead. + $pkg{'package'} = $pkg; + } + + next; + } + + if ($found) { + chop; + + if (/^Version: (.*)$/) { + $pkg{'version'} = $1; + } elsif (/^Priority: (.*)$/) { + $pkg{'priority'} = $1; + } elsif (/^Section: (.*)$/) { + $pkg{'section'} = $1; + } elsif (/^Size: (.*)$/) { + $pkg{'size'} = $1; + } elsif (/^Installed-Size: (.*)$/i) { + $pkg{'installed'} = $1; + } elsif (/^Description: (.*)$/) { + $pkg{'desc'} = $1; + } elsif (/^Filename: (.*)$/) { + $pkg{'find'} = $1; + } elsif (/^Pre-Depends: (.*)$/) { + $pkg{'depends'} = "pre-depends on $1"; + } elsif (/^Depends: (.*)$/) { + if (exists $pkg{'depends'}) { + $pkg{'depends'} .= "; depends on $1"; + } else { + $pkg{'depends'} = "depends on $1"; + } + } elsif (/^Maintainer: (.*)$/) { + $pkg{'maint'} = $1; + } elsif (/^Provides: (.*)$/) { + $pkg{'provides'} = $1; + } elsif (/^Suggests: (.*)$/) { + $pkg{'suggests'} = $1; + } elsif (/^Conflicts: (.*)$/) { + $pkg{'conflicts'} = $1; + } + +### &::DEBUG("=> '$_'."); + } + + # blank line. + if (/^$/) { + undef $pkg; + last if ($found); + next; + } + + next if (defined $pkg); + } + + close IN; + + %pkg; +} + +# Usage: &infoPackages($query,$package); +sub infoPackages { + my ($query,$dist,$package) = ($_[0], &getDistroFromStr($_[1])); + + &::status("Debian: Searching for package '$package' in '$dist'."); + + # download packages file. + # hrm... + my %urls = &fixDist($dist, %urlpackages); + if ($dist ne "incoming") { + &::DEBUG("deb: download 3.") if ($debug); + + if (!&DebianDownload($dist, %urls)) { # no good download. + &::WARN("Debian(iP): could not download ANY files."); + } + } + + # check if the package is valid. + my $incoming = 0; + my @files = &validPackage($package, $dist); + if (!scalar @files) { + &::status("Debian: no valid package found; checking incoming."); + @files = &validPackage($package, "incoming"); + + if (scalar @files) { + &::status("Debian: cool, it exists in incoming."); + $incoming++; + } else { + &::msg($::who, "Package '$package' does not exist."); + return 0; + } + } + + if (scalar @files > 1) { + &::WARN("same package in more than one file; random."); + &::DEBUG("THIS SHOULD BE FIXED SOMEHOW!!!"); + $files[0] = &::getRandom(@files); + } + + if (! -f $files[0]) { + &::WARN("files[0] ($files[0]) doesn't exist."); + &::msg($::who, "FIXME: $files[0] does not exist?"); + return 'NULL'; + } + + ### TODO: if specific package is requested, note down that a version + ### exists in incoming. + + my $found = 0; + my $file = $files[0]; + my ($pkg); + + ### TODO: use fe, dump to a hash. if only one version of the package + ### exists. do as normal otherwise list all versions. + if (! -f $file) { + &::ERROR("D:iP: file '$file' DOES NOT EXIST!!! should never happen."); + return 0; + } + my %pkg = &getPackageInfo($package, $file); + + $query = "info" if ($query eq "dinfo"); + + # 'fm'-like output. + if ($query eq "info") { + if (scalar keys %pkg <= 5) { + &::DEBUG("deb: running debianCheck() due to problems (".scalar(keys %pkg).")."); + &debianCheck(); + &::DEBUG("deb: end of debianCheck()"); + + &::msg($::who,"Debian: Package appears to exist but I could not retrieve info about it..."); + return; + } + + $pkg{'info'} = "\002(\002". $pkg{'desc'} ."\002)\002"; + $pkg{'info'} .= ", section ".$pkg{'section'}; + $pkg{'info'} .= ", is ".$pkg{'priority'}; +# $pkg{'info'} .= ". Version: \002$pkg{'version'}\002"; + $pkg{'info'} .= ". Version: \002$pkg{'version'}\002 ($dist)"; + $pkg{'info'} .= ", Packaged size: \002". int($pkg{'size'}/1024) ."\002 kB"; + $pkg{'info'} .= ", Installed size: \002$pkg{'installed'}\002 kB"; + + if ($incoming) { + &::status("iP: info requested and pkg is in incoming, too."); + my %incpkg = &getPackageInfo($query, $debian_dir ."/Packages-incoming"); + + if (scalar keys %incpkg) { + $pkg{'info'} .= ". Is in incoming ($incpkg{'file'})."; + } else { + &::ERROR("iP: pkg $query is in incoming but we couldn't get any info?"); + } + } + } + + if ($dist eq "incoming") { + $pkg{'info'} .= "Version: \002$pkg{'version'}\002"; + $pkg{'info'} .= ", Packaged size: \002". int($pkg{'size'}/1024) ."\002 kB"; + $pkg{'info'} .= ", is in incoming!!!"; + } + + if (!exists $pkg{$query}) { + if ($query eq "suggests") { + $pkg{$query} = "has no suggestions"; + } elsif ($query eq "conflicts") { + $pkg{$query} = "does not conflict with any other package"; + } elsif ($query eq "depends") { + $pkg{$query} = "does not depend on anything"; + } elsif ($query eq "maint") { + $pkg{$query} = "has no maintainer"; + } else { + $pkg{$query} = "has nothing about $query"; + } + } + + &::performStrictReply("$package: $pkg{$query}"); +} + +# Usage: &infoStats($dist); +sub infoStats { + my ($dist) = @_; + $dist = &getDistro($dist); + return unless (defined $dist); + + &::DEBUG("deb: infoS: dist => '$dist'."); + + # download packages file if needed. + my %urls = &fixDist($dist, %urlpackages); + &::DEBUG("deb: download 4."); + if (!&DebianDownload($dist, %urls)) { + &::WARN("Debian(iS): could not download ANY files."); + &::msg($::who, "Debian(iS): internal error."); + return; + } + + my %stats; + my %total = (count => 0, maint => 0, isize => 0, csize => 0); + my $file; + foreach $file (keys %urlpackages) { + $file =~ s/##DIST/$dist/g; # won't work for incoming. + &::DEBUG("deb: file => '$file'."); + if (exists $stats{$file}{'count'}) { + &::DEBUG("deb: hrm... duplicate open with $file???"); + next; + } + + open(IN, "zcat $debian_dir/$file 2>&1 |"); + + if (! -e "$debian_dir/$file") { + &::DEBUG("deb: iS: $debian_dir/$file does not exist."); + next; + } + + while (!eof IN) { + $_ = ; + + next if (/^ \S+/); # package long description. + + if (/^Package: (.*)\n$/) { # counter. + $stats{$file}{'count'}++; + $total{'count'}++; + } elsif (/^Maintainer: .* <(\S+)>$/) { + $stats{$file}{'maint'}{$1}++; + $total{'maint'}{$1}++; + } elsif (/^Size: (.*)$/) { # compressed size. + $stats{$file}{'csize'} += $1; + $total{'csize'} += $1; + } elsif (/^i.*size: (.*)$/i) { # installed size. + $stats{$file}{'isize'} += $1; + $total{'isize'} += $1; + } + +### &::DEBUG("=> '$_'."); + } + close IN; + } + + ### TODO: don't count ppl with multiple email addresses. + + &::performStrictReply( + "Debian Distro Stats on $dist... ". + "\002$total{'count'}\002 packages, ". + "\002".scalar(keys %{ $total{'maint'} })."\002 maintainers, ". + "\002". int($total{'isize'}/1024)."\002 MB installed size, ". + "\002". int($total{'csize'}/1024/1024)."\002 MB compressed size." + ); + +### TODO: do individual stats? if so, we need _another_ arg. +# foreach $file (keys %stats) { +# foreach (keys %{ $stats{$file} }) { +# &::DEBUG(" '$file' '$_' '$stats{$file}{$_}'."); +# } +# } + + return; +} + +### +# HELPER FUNCTIONS FOR INFOPACKAGES... +### + +# Usage: &generateIndex(); +sub generateIndex { + my (@dists) = @_; + &::DEBUG("D: generateIndex($dists[0]) called!"); + if (!scalar @dists or $dists[0] eq '') { + &::ERROR("gI: no dists to generate index."); + return 1; + } + + foreach (@dists) { + my $dist = &getDistro($_); # incase the alias is returned, possible? + my $idx = $debian_dir."/Packages-$dist.idx"; + + # TODO: check if any of the Packages file have been updated then + # regenerate it, even if it's not stale. + # TODO: also, regenerate the index if the packages file is newer + # than the index. + next unless (&::isStale($idx, $refresh)); + + if (/^incoming$/i) { + &::DEBUG("deb: gIndex: calling generateIncoming()!"); + &generateIncoming(); + next; + } + + if (/^woody$/i) { + &::DEBUG("deb: Copying old index of woody to -old"); + system("cp $idx $idx-old"); + } + + &::DEBUG("deb: gIndex: calling DebianDownload($dist, ...).") if ($debug); + &DebianDownload($dist, &fixDist($dist, %urlpackages) ); + + &::status("Debian: generating index for '$dist'."); + if (!open OUT, ">$idx") { + &::ERROR("cannot write to $idx."); + return 0; + } + + my $packages; + foreach $packages (keys %urlpackages) { + $packages =~ s/##DIST/$dist/; + $packages = "$debian_dir/$packages"; + + if (! -e $packages) { + &::ERROR("gIndex: '$packages' does not exist?"); + next; + } + + print OUT "*$packages\n"; + open(IN,"zcat $packages |"); + + while () { + next unless (/^Package: (.*)\n$/); + print OUT $1."\n"; + } + close IN; + } + close OUT; + } + + return 1; +} + +# Usage: &validPackage($package, $dist); +sub validPackage { + my ($package,$dist) = @_; + my @files; + my $file; + + ### this majorly sucks, we need some standard in place. + # why is this needed... need to investigate later. + my $olddist = $dist; + $dist = &getDistro($dist); + + &::DEBUG("deb: validPackage($package, $dist) called.") if ($debug); + + my $error = 0; + while (!open IN, $debian_dir."/Packages-$dist.idx") { + if ($error) { + &::ERROR("Packages-$dist.idx does not exist (#1)."); + return; + } + + &generateIndex($dist); + + $error++; + } + + my $count = 0; + while () { + if (/^\*(.*)\n$/) { + $file = $1; + next; + } + + if (/^\Q$package\E\n$/) { + push(@files,$file); + } + $count++; + } + close IN; + + &::VERB("vP: scanned $count items in index.",2); + + return @files; +} + +sub searchPackage { + my ($dist, $query) = &getDistroFromStr($_[0]); + my $file = $debian_dir."/Packages-$dist.idx"; + my $warn = ($query =~ tr/A-Z/a-z/) ? 1 : 0; + my $error = 0; + my @files; + + &::status("Debian: Search package matching '$query' in '$dist'."); + unlink $file if ( -z $file ); + + while (!open IN, $file) { + if ($dist eq "incoming") { + &::DEBUG("deb: sP: dist == incoming; calling gI()."); + &generateIncoming(); + } + + if ($error) { + &::ERROR("could not generate index ($file)!"); + return; + } + + $error++; + &::DEBUG("deb: should we be doing this?"); + &generateIndex(($dist)); + } + + while () { + chop; + + if (/^\*(.*)$/) { + $file = $1; + + if (&::isStale($file, $refresh)) { + &::DEBUG("deb: STALE $file! regen.") if ($debug); + &generateIndex(($dist)); +### @files = searchPackage("$query $dist"); + &::DEBUG("deb: EVIL HACK HACK HACK.") if ($debug); + last; + } + + next; + } + + if (/\Q$query\E/) { + push(@files,$_); + } + } + close IN; + + if (scalar @files and $warn) { + &::msg($::who, "searching for package name should be fully lowercase!"); + } + + return @files; +} + +sub getDistro { + my $dist = $_[0]; + + if (!defined $dist or $dist eq "") { + &::DEBUG("deb: gD: dist == NULL; dist = defaultdist."); + $dist = $defaultdist; + } + + if ($dist =~ /^(slink|hamm|rex|bo)$/i) { + &::DEBUG("deb: deprecated version ($dist)."); + &::msg($::who, "Debian: deprecated distribution version."); + return; + } + + if (exists $dists{$dist}) { + &::VERB("gD: returning dists{$dist} ($dists{$dist})",2); + return $dists{$dist}; + + } else { + if (!grep /^\Q$dist\E$/i, %dists) { + &::msg($::who, "invalid dist '$dist'."); + return; + } + + &::VERB("gD: returning $dist (no change or conversion)",2); + return $dist; + } +} + +sub getDistroFromStr { + my ($str) = @_; + my $dists = join '|', %dists; + my $dist = $defaultdist; + + if ($str =~ s/\s+($dists)$//i) { + $dist = &getDistro(lc $1); + $str =~ s/\\+$//; + } + $str =~ s/\\([\$\^])/$1/g; + + return($dist,$str); +} + +sub fixDist { + my ($dist, %urls) = @_; + my %new; + my ($key,$val); + + while (($key,$val) = each %urls) { + $key =~ s/##DIST/$dist/; + $val =~ s/##DIST/$dist/; + ### TODO: what should we do if the sar wasn't done. + $new{$debian_dir."/".$key} = $val; + } + + return %new; +} + +sub DebianFind { + # HACK! HACK! HACK! + my ($str) = @_; + my ($dist, $query) = &getDistroFromStr($str); + my @results = sort &searchPackage($str); + + if (!scalar @results) { + &::Forker("Debian", sub { &searchContents($str); } ); + } elsif (scalar @results == 1) { + &::status("searchPackage returned one result; getting info of package instead!"); + &::Forker("Debian", sub { &infoPackages("info", "$results[0] $dist"); } ); + } else { + my $prefix = "Debian Package Listing of '$query' "; + &::performStrictReply( &::formListReply(0, $prefix, @results) ); + } +} + +sub debianCheck { + my $error = 0; + + &::status("debianCheck() called."); + + ### TODO: remove the following loop (check if dir exists before) + while (1) { + last if (opendir(DEBIAN, $debian_dir)); + + if ($error) { + &::ERROR("dC: cannot opendir debian."); + return; + } + + mkdir $debian_dir, 0755; + $error++; + } + + my $retval = 0; + my $file; + while (defined($file = readdir DEBIAN)) { + next unless ($file =~ /(gz|bz2)$/); + + # TODO: add bzip2 support (debian doesn't do .bz2 anyway) + #my $exit = system("/bin/gzip -t '$debian_dir/$file'"); + #next unless ($exit); + &::DEBUG("deb: hmr... => ".(time() - (stat($file))[8])."'."); + next unless (time() - (stat($file))[8] > 3600); + + #&::DEBUG("deb: dC: exit => '$exit'."); + &::WARN("dC: '$debian_dir/$file' corrupted? deleting!"); + unlink $debian_dir."/".$file; + $retval++; + } + + return $retval; +} + +sub checkEval { + my($str) = @_; + + if ($str) { + &::WARN("cE: $str"); + return 0; + } else { + return 1; + } +} + +sub searchDescFE { +# &::DEBUG("deb: FE called for searchDesc"); + my ($query) = @_; + my @list = &searchDesc($query); + + if (!scalar @list) { + my $prefix = "Debian Desc Search of '$query' "; + &::performStrictReply( &::formListReply(0, $prefix, ) ); + } elsif (scalar @list == 1) { # list = 1. + &::DEBUG("deb: list == 1; showing package info of '$list[0]'."); + &infoPackages("info", $list[0]); + } else { # list > 1. + my $prefix = "Debian Desc Search of '$query' "; + &::performStrictReply( &::formListReply(0, $prefix, @list) ); + } +} + +1; diff --git a/src/Modules/DebianExtra.pl b/src/Modules/DebianExtra.pl new file mode 100644 index 0000000..8200d45 --- /dev/null +++ b/src/Modules/DebianExtra.pl @@ -0,0 +1,183 @@ +# +# DebianExtra.pl: Extra stuff for debian +# Author: dms +# Version: v0.1 (20000520) +# Created: 20000520 +# + +use strict; + +package DebianExtra; + +sub Parse { + my($args) = @_; + my($msg) = ''; + + #&::DEBUG("DebianExtra: $args\n"); + if (!defined $args or $args =~ /^$/) { + $msg = &debianBugs(); + } elsif ($args =~ /^(\d+)$/) { + # package number: + $msg = &do_id($args); + } elsif ($args =~ /^(\S+\@\S+)$/) { + # package email maintainer. + $msg = &do_email($args); + } elsif ($args =~ /^(\S+)$/) { + # package name. + $msg = &do_pkg($args); + } else { + # invalid. + $msg = "error: could not parse $args"; + } + &::performStrictReply($msg); +} + +sub debianBugs { + my @results = &::getURL("http://master.debian.org/~wakkerma/bugs"); + my ($date, $rcbugs, $remove); + my ($bugs_closed, $bugs_opened) = (0,0); + + if (scalar @results) { + foreach (@results) { + s/<.*?>//g; + $date = $1 if (/status at (.*)\s*$/); + $rcbugs = $1 if (/bugs: (\d+)/); + $remove = $1 if (/REMOVE\S+ (\d+)\s*$/); + if (/^(\d+) r\S+ b\S+ w\S+ c\S+ a\S+ (\d+)/) { + $bugs_closed = $1; + $bugs_opened = $2; + } + } + my $xtxt = ($bugs_closed >=$bugs_opened) ? + "It's good to see " : + "Oh no, the bug count is rising -- "; + + &::performStrictReply( + "Debian bugs statistics, last updated on $date... ". + "There are \002$rcbugs\002 release-critical bugs; $xtxt". + "\002$bugs_closed\002 bugs closed, opening \002$bugs_opened\002 bugs. ". + "About \002$remove\002 packages will be removed." + ); + } else { + &::msg($::who, "Couldn't retrieve data for debian bug stats."); + } +} + +sub do_id($){ + my ($bug_num) = shift; + + if (not $bug_num =~ /^\#?\d+$/) { + return "Bug is not a number!"; + } + $bug_num =~ s/^\#//; + my @results = &::getURL("http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=$bug_num"); + my $report = join("\n", @results); + + # strip down report to relevant header information. + $report =~ s/\r//sig; + $report =~ /]*>(.+?)
/si; + $report = $1; + my $bug = {}; + ($bug->{num}, $bug->{title}) = $report =~ m#\#(\d+)\<\/A\>\(.+?)\<\/H1\>#is; + &::DEBUG("Bugnum: $bug->{num}\n"); + $bug->{title} =~ s/</\{title} =~ s/>/\>/g; + $bug->{title} =~ s/"/\"/g; + &::DEBUG("Title: $bug->{title}\n"); + $bug->{severity} = 'n'; #Default severity is normal + my @bug_flags = split /(?{severity}) = $bug_flag =~ /(wishlist|minor|normal|important|serious|grave)/i; + # Just leave the leter instead of the whole thing. + $bug->{severity} =~ s/^(.).+$/$1/; + } + elsif ($bug_flag =~ /Package:/) { + ($bug->{package}) = $bug_flag =~ /\"\>\s*([^<>]+?)\s*\<\/a\>/; + # take packagename out of title if it's there + $bug->{title} =~ s/^$bug->{package}: //; + } + elsif ($bug_flag =~ /Reported by:/) { + ($bug->{reporter}) = $bug_flag =~ /\"\>\s*(.+?)\s*\<\/a\>/; + # strip < and > + $bug->{reporter} =~ s/</\{reporter} =~ s/>/\>/g; + } + elsif ($bug_flag =~ /Date:/) { + ($bug->{date}) = $bug_flag =~ /Date:\s*(\w.+?)\s*$/; + #ditch extra whitespace + $bug->{date} =~ s/\s{2,}/\ /; + } + elsif ($bug_flag =~ /Tags:/) { + ($bug->{tags}) = $bug_flag =~ /strong\>\s*(.+?)\s*\<\/strong\>/; + } + elsif ($bug_flag =~ /merged with /) { + $bug_flag =~ s/merged with\s*//; + $bug_flag =~ s/\<[^\>]+\>//g; + $bug_flag =~ s/\s//sg; + $bug->{merged_with} = $bug_flag; + + } + elsif ($bug_flag =~ /\>Done:\{done} = 1; + } + } + + # report bug + + $report = ''; + $report .= 'DONE:' if defined $bug->{done} and $bug->{done}; + $report .= '#'.$bug->{num}.':'.uc($bug->{severity}).'['.$bug->{package}.'] '.$bug->{title}; + $report .= ' ('.$bug->{tags}.')' if defined $bug->{tags}; + $report .= ' ' . $bug->{date}; + # Avoid reporting so many merged bugs. + $report .= ' ['.join(',',splice(@{[split(/,/,$bug->{merged_with})]},0,3)).']' if defined $bug->{merged_with}; + if ($::DEBUG) { + use Data::Dumper; + &::DEBUG(Dumper($bug)); + } + return $report; +} + +sub old_do_id { + my($num) = @_; + my $url = "http://bugs.debian.org/$num"; + + # FIXME + return "do_id not supported yet."; + + my @results = &::getURL($url); + foreach (@results) { + &::DEBUG("do_id: $_"); + } +} + +sub do_email { + my($email) = @_; + my $url = "http://bugs.debian.org/$email"; + + # FIXME + return "do_email not supported yet."; + + my @results = &::getURL($url); + foreach (@results) { + &::DEBUG("do_email: $_"); + } +} + +sub do_pkg { + my($pkg) = @_; + my $url = "http://bugs.debian.org/$pkg"; + + # FIXME + return "do_pkg not supported yet."; + + my @results = &::getURL($url); + foreach (@results) { + &::DEBUG("do_pkg: $_"); + } +} + +1; diff --git a/src/Modules/Dict.pl b/src/Modules/Dict.pl new file mode 100644 index 0000000..8fccf13 --- /dev/null +++ b/src/Modules/Dict.pl @@ -0,0 +1,184 @@ +# +# Dict.pl: Frontend to dict.org. +# Author: dms +# Version: v0.6c (20000924). +# Created: 19990914. +# Updates: Copyright (c) 2005 - Tim Riker +# +# see http://luetzschena-stahmeln.de/dictd/ +# for a list of dict servers + +package Dict; + +use IO::Socket; +use strict; + +#use vars qw(PF_INET); + +# need a specific host||ip. +my $server = "dict.org"; + +sub Dict { + my ($query) = @_; +# return unless &::loadPerlModule("IO::Socket"); + my $port = 2628; + my $proto = getprotobyname('tcp'); + my @results; + my $retval; + + for ($query) { + s/^[\s\t]+//; + s/[\s\t]+$//; + s/[\s\t]+/ /; + } + + # connect. + # TODO: make strict-safe constants... so we can defer IO::Socket load. + my $socket = new IO::Socket; + socket($socket, PF_INET, SOCK_STREAM, $proto) or return "error: socket: $!"; + eval { + local $SIG{ALRM} = sub { die 'alarm' }; + alarm 10; + connect($socket, sockaddr_in($port, inet_aton($server))) or die "error: connect: $!"; + alarm 0; + }; + + if ($@) { + # failure. + $retval = "i could not get info from $server '$@'"; + } else { # success. + $socket->autoflush(1); # required. + + my $num; + if ($query =~ s/^(\d+)\s+//) { + $num = $1; + } + my $dict = '*'; + if ($query =~ s/\/(\S+)$//) { + $dict = $1; + } + + # body. + push(@results, &Define($socket,$query,$dict)); + #push(@results, &Define($socket,$query,'foldoc')); + #push(@results, &Define($socket,$query,'web1913')); + # end. + + print $socket "QUIT\n"; + close $socket; + + my $count=0; + foreach (@results) { + $count++; + &::DEBUG("$count: $_"); + } + my $total = scalar @results; + + if ($total == 0) { + $num = undef; + } + + if (defined $num and ($num > $total or $num < 1)) { + &::msg($::who, "error: choice in definition is out of range."); + return; + } + + # parse the results. + if ($total > 1) { + if (defined $num) { + $retval = sprintf("[%d/%d] %s", $num, $total, $results[$num-1]); + } else { + # suggested by larne and others. + my $prefix = "Dictionary '$query' "; + $retval = &::formListReply(1, $prefix, @results); + } + } elsif ($total == 1) { + $retval = "Dictionary '$query' ".$results[0]; + } else { + $retval = "could not find definition for \002$query\002"; + $retval .= " in $dict" if ($dict ne '*'); + } + } + + &::performStrictReply($retval); +} + +sub Define { + my ($socket, $query, $dict) = @_; + my @results; + + &::DEBUG("Dict: asking $dict."); + print $socket "DEFINE $dict \"$query\"\n"; + + my $def = ''; + my $term = $query; + + while (<$socket>) { + chop; # remove \n + chop; # remove \r + + &::DEBUG("$term/$dict '$_'"); + if (/^552 /) { + # no match. + return; + } elsif (/^250 /) { + # end w/ optional stats + last; + } elsif (/^151 "([^"]*)" (\S+) .*/) { + # 151 "Good Thing" jargon "Jargon File (4.3.0, 30 APR 2001)" + $term=$1; + $dict=$2; + $def = ''; + &::DEBUG("term=$term dict=$dict"); + } else { + my $line = $_; + # some dicts put part of the definition on the same line ie: jargon + $line =~ s/^$term//i; + $line =~ s/^\s+/ /; + if ($dict eq 'wn') { + # special processing for sub defs in wordnet + if ($line eq '.') { + # end of def. + $def =~ s/\s+$//; + $def =~ s/\[[^\]]*\]//g; + push(@results, $def); + } elsif ($line =~ m/^\s+(\S+ )?(\d+)?: (.*)/) { + # start of sub def. + my $text = $3; + $def =~ s/\s+$//; + #&::DEBUG("def => '$def'."); + $def =~ s/\[[^\]]*\]//g; + push(@results, $def) if ($def ne ''); + $def = $text; + } elsif (/^\s+(.*)/) { + $def .= $line; + } else { + &::DEBUG("ignored '$line'"); + } + } else { + # would be nice to divide other dicts + # but many are not always in a parsable format + if ($line eq '.') { + # end of def. + next if ($def eq ''); + push(@results, $def); + $def = ''; + } elsif ($line =~ m/^\s+(\S.*\S)\s*$/) { + #&::DEBUG("got '$1'"); + $def .= ' ' if ($def ne ''); + $def .= $1; + } else { + &::DEBUG("ignored '$line'"); + } + } + } + } + + &::DEBUG("Dict: $dict: found ". scalar(@results) ." defs."); + + return if (!scalar @results); + + return @results; +} + +1; diff --git a/src/Modules/DumpVars.pl b/src/Modules/DumpVars.pl new file mode 100644 index 0000000..80037b0 --- /dev/null +++ b/src/Modules/DumpVars.pl @@ -0,0 +1,135 @@ +# +# DumpVars.pl: Perl variables dumper. +# Maintained: dms +# Version: v0.1 (20000114) +# Created: 20000114 +# NOTE: Ripped from ActivePerl "asp sample" example. +# + +# FIXME +#use strict; + +#use vars qw(); + +my $countlines = 0; + +sub dumpvarslog { + my ($line) = @_; + if (&IsParam('dumpvarsLogFile')) { + print DUMPVARS $line."\n"; + } else { + &status("DV: ".$line); + } +} + +sub DumpNames(\%$) { + my ($package,$packname) = @_; + my $symname = 0; + my $line; + + if ($packname eq 'main::') { + &dumpvarslog('Packages'); + + foreach $symname (sort keys %$package) { + local *sym = $$package{$symname}; + next unless (defined %sym); + next unless ($symname =~/::/); + &dumpvarslog(" $symname"); + $countlines++; + } + } + + # Scalars. + foreach $symname (sort keys %$package) { + local *sym = $$package{$symname}; + next unless (defined $sym); + + my $line; + if (length($sym) > 512) { + &dumpvarslog("Scalar '$packname' $symname too long."); + } else { + &dumpvarslog("Scalar '$packname' \$ $symname => '$sym'"); + } + $countlines++; + } + + # Functions. + foreach $symname (sort keys %$package) { + local *sym = $$package{$symname}; + next unless (defined &sym); + + &dumpvarslog("Function '$packname' $symname()"); + $countlines++; + } + + # Lists. + foreach $symname (sort keys %$package) { + local *sym = $$package{$symname}; + next unless (defined @sym); + + &dumpvarslog("List '$packname' \@$symname (". scalar(@{$symname}) .")"); + $countlines++; + + next unless ($packname eq 'main::'); + foreach (@{$symname}) { + if (defined $_) { + &dumpvarslog(" => '$_'."); + } else { + &dumpvarslog(" => ."); + } + } + } + + # Hashes. + foreach $symname (sort keys %$package) { + local *sym = $$package{$symname}; + next unless (defined %sym); + next if ($symname =~/::/); + + &dumpvarslog("Hash '$packname' \%$symname"); + $countlines++; + + next unless ($packname eq 'main::'); + foreach (keys %{$symname}) { + my $val = ${$symname}{$_}; + if (defined $val) { + &dumpvarslog(" $_ => '$val'."); + } else { + &dumpvarslog(" $_ => ."); + } + } + } + + return unless ($packname eq 'main::'); + + foreach $symname (sort keys %$package) { + local *sym = $$package{$symname}; + next unless (defined %sym); + next unless ($symname =~/::/); + next if ($symname eq 'main::'); + + DumpNames(\%sym,$symname) + } +} + +sub dumpallvars { + if (&IsParam('dumpvarsLogFile')) { + my $file = $param{'dumpvarsLogFile'}; + &status("opening fh to dumpvars ($file)"); + if (!open(DUMPVARS,">$file")) { + &ERROR("cannot open dumpvars."); + return; + } + } + + DumpNames(%main::,'main::'); + + if (&IsParam('dumpvarsLogFile')) { + &status("closing fh to dumpvars"); + close DUMPVARS; + } + + &status("DV: count == $countlines"); +} + +1; diff --git a/src/Modules/DumpVars2.pl b/src/Modules/DumpVars2.pl new file mode 100644 index 0000000..2049846 --- /dev/null +++ b/src/Modules/DumpVars2.pl @@ -0,0 +1,66 @@ +# +# DumpVars2.pl: Perl variables dumper ][. +# Maintained: dms +# Version: v0.1 (20020329) +# Created: 20020329 +# + +# use strict; # TODO + +use Devel::Symdump; + +sub symdumplog { + my ($line) = @_; + + if (fileno SYMDUMP) { + print SYMDUMP $line."\n"; + } else { + &status("SD: ".$line); + } +} + +sub symdumpAll { + my $o = Devel::Symdump->rnew(); + + # scalars. + foreach ($o->scalars) { +# &symdumpRecur($_); + symdumplog(" scalar($_)"); + } +} + +sub symdumpRecur { + my $x = shift; + + if (ref $x eq 'HASH') { + foreach (keys %$x) { + &symdumpRecur($_); + } + } else { + symdumplog("unknown: $x"); + } +} + +sub symdumpAllFile { + &DEBUG('before open'); + if (&IsParam('symdumpLogFile')) { + my $file = $param{'symdumpLogFile'}; + &status("opening fh to symdump ($file)"); + if (!open(SYMDUMP,">$file")) { + &ERROR('cannot open dumpvars.'); + return; + } + } + &DEBUG('after open'); + + symdumpAll(); + + if (fileno SYMDUMP) { + &status('closing fh to symdump'); + close SYMDUMP; + } + + &status("SD: count == $countlines"); +} + +1; diff --git a/src/Modules/Exchange.pl b/src/Modules/Exchange.pl new file mode 100644 index 0000000..e61fa74 --- /dev/null +++ b/src/Modules/Exchange.pl @@ -0,0 +1,424 @@ +#!/usr/bin/perl + +# Exchange.pl - currency exchange 'module' +# +# Last update: 990818 08:30:10, bobby@bofh.dk +# 20021111 Tim Riker +# + +package Exchange; +use strict; + +my $no_exchange; + +BEGIN { + eval qq{ + use LWP::UserAgent; + use HTTP::Request::Common qw(POST GET); + }; + + $no_exchange++ if ($@); +} + +sub GetAbb { + my($LookFor,%Hash) = @_; + + my $Found = (grep /$LookFor/i, keys %Hash)[0]; + $Found =~ m/\((\w\w\w)\)/; + return $1; +} + +sub GetTlds { + my %Hash = ( + 'AF', 'AFGHANISTAN', + 'AL', 'ALBANIA', + 'DZ', 'ALGERIA', + 'AS', 'AMERICAN SAMOA', + 'AD', 'ANDORRA', + 'AO', 'ANGOLA', + 'AI', 'ANGUILLA', + 'AQ', 'ANTARCTICA', + 'AG', 'ANTIGUA AND BARBUDA', + 'AR', 'ARGENTINA', + 'AM', 'ARMENIA', + 'AW', 'ARUBA', + 'AU', 'AUSTRALIA', + 'AT', 'AUSTRIA', + 'AZ', 'AZERBAIJAN', + 'BS', 'BAHAMAS', + 'BH', 'BAHRAIN', + 'BD', 'BANGLADESH', + 'BB', 'BARBADOS', + 'BY', 'BELARUS', + 'BE', 'BELGIUM', + 'BZ', 'BELIZE', + 'BJ', 'BENIN', + 'BM', 'BERMUDA', + 'BT', 'BHUTAN', + 'BO', 'BOLIVIA', + 'BA', 'BOSNIA AND HERZEGOWINA', + 'BW', 'BOTSWANA', + 'BV', 'BOUVET ISLAND', + 'BR', 'BRAZIL', + 'IO', 'BRITISH INDIAN OCEAN TERRITORY', + 'BN', 'BRUNEI DARUSSALAM', + 'BG', 'BULGARIA', + 'BF', 'BURKINA FASO', + 'BI', 'BURUNDI', + 'KH', 'CAMBODIA', + 'CM', 'CAMEROON', + 'CA', 'CANADA', + 'CV', 'CAPE VERDE', + 'KY', 'CAYMAN ISLANDS', + 'CF', 'CENTRAL AFRICAN REPUBLIC', + 'TD', 'CHAD', + 'CL', 'CHILE', + 'CN', 'CHINA', + 'CX', 'CHRISTMAS ISLAND', + 'CC', 'COCOS (KEELING) ISLANDS', + 'CO', 'COLOMBIA', + 'KM', 'COMOROS', + 'CG', 'CONGO', + 'CD', 'CONGO, THE DEMOCRATIC REPUBLIC OF THE', + 'CK', 'COOK ISLANDS', + 'CR', 'COSTA RICA', + 'CI', "COTE D'IVOIRE", + 'HR', 'CROATIA (local name: Hrvatska)', + 'CU', 'CUBA', + 'CY', 'CYPRUS', + 'CZ', 'CZECH REPUBLIC', + 'DK', 'DENMARK', + 'DJ', 'DJIBOUTI', + 'DM', 'DOMINICA', + 'DO', 'DOMINICAN REPUBLIC', + 'TP', 'EAST TIMOR', + 'EC', 'ECUADOR', + 'EG', 'EGYPT', + 'SV', 'EL SALVADOR', + 'GQ', 'EQUATORIAL GUINEA', + 'ER', 'ERITREA', + 'EE', 'ESTONIA', + 'ET', 'ETHIOPIA', + 'FK', 'FALKLAND ISLANDS (MALVINAS)', + 'FO', 'FAROE ISLANDS', + 'FJ', 'FIJI', + 'FI', 'FINLAND', + 'FR', 'FRANCE', + 'FX', 'FRANCE, METROPOLITAN', + 'GF', 'FRENCH GUIANA', + 'PF', 'FRENCH POLYNESIA', + 'TF', 'FRENCH SOUTHERN TERRITORIES', + 'GA', 'GABON', + 'GM', 'GAMBIA', + 'GE', 'GEORGIA', + 'DE', 'GERMANY', + 'GH', 'GHANA', + 'GI', 'GIBRALTAR', + 'GR', 'GREECE', + 'GL', 'GREENLAND', + 'GD', 'GRENADA', + 'GP', 'GUADELOUPE', + 'GU', 'GUAM', + 'GT', 'GUATEMALA', + 'GN', 'GUINEA', + 'GW', 'GUINEA-BISSAU', + 'GY', 'GUYANA', + 'HT', 'HAITI', + 'HM', 'HEARD AND MC DONALD ISLANDS', + 'VA', 'HOLY SEE (VATICAN CITY STATE)', + 'HN', 'HONDURAS', + 'HK', 'HONG KONG', + 'HU', 'HUNGARY', + 'IS', 'ICELAND', + 'IN', 'INDIA', + 'ID', 'INDONESIA', + 'IR', 'IRAN (ISLAMIC REPUBLIC OF)', + 'IQ', 'IRAQ', + 'IE', 'IRELAND', + 'IL', 'ISRAEL', + 'IT', 'ITALY', + 'JM', 'JAMAICA', + 'JP', 'JAPAN', + 'JO', 'JORDAN', + 'KZ', 'KAZAKHSTAN', + 'KE', 'KENYA', + 'KI', 'KIRIBATI', + 'KP', "KOREA, DEMOCRATIC PEOPLE'S REPUBLIC OF", + 'KR', 'KOREA, REPUBLIC OF', + 'KW', 'KUWAIT', + 'KG', 'KYRGYZSTAN', + 'LA', "LAO PEOPLE'S DEMOCRATIC REPUBLIC", + 'LV', 'LATVIA', + 'LB', 'LEBANON', + 'LS', 'LESOTHO', + 'LR', 'LIBERIA', + 'LY', 'LIBYAN ARAB JAMAHIRIYA', + 'LI', 'LIECHTENSTEIN', + 'LT', 'LITHUANIA', + 'LU', 'LUXEMBOURG', + 'MO', 'MACAU', + 'MK', 'MACEDONIA, THE FORMER YUGOSLAV REPUBLIC OF', + 'MG', 'MADAGASCAR', + 'MW', 'MALAWI', + 'MY', 'MALAYSIA', + 'MV', 'MALDIVES', + 'ML', 'MALI', + 'MT', 'MALTA', + 'MH', 'MARSHALL ISLANDS', + 'MQ', 'MARTINIQUE', + 'MR', 'MAURITANIA', + 'MU', 'MAURITIUS', + 'YT', 'MAYOTTE', + 'MX', 'MEXICO', + 'FM', 'MICRONESIA, FEDERATED STATES OF', + 'MD', 'MOLDOVA, REPUBLIC OF', + 'MC', 'MONACO', + 'MN', 'MONGOLIA', + 'MS', 'MONTSERRAT', + 'MA', 'MOROCCO', + 'MZ', 'MOZAMBIQUE', + 'MM', 'MYANMAR', + 'NA', 'NAMIBIA', + 'NR', 'NAURU', + 'NP', 'NEPAL', + 'NL', 'NETHERLANDS', + 'AN', 'NETHERLANDS ANTILLES', + 'NC', 'NEW CALEDONIA', + 'NZ', 'NEW ZEALAND', + 'NI', 'NICARAGUA', + 'NE', 'NIGER', + 'NG', 'NIGERIA', + 'NU', 'NIUE', + 'NF', 'NORFOLK ISLAND', + 'MP', 'NORTHERN MARIANA ISLANDS', + 'NO', 'NORWAY', + 'OM', 'OMAN', + 'PK', 'PAKISTAN', + 'PW', 'PALAU', + 'PA', 'PANAMA', + 'PG', 'PAPUA NEW GUINEA', + 'PY', 'PARAGUAY', + 'PE', 'PERU', + 'PH', 'PHILIPPINES', + 'PN', 'PITCAIRN', + 'PL', 'POLAND', + 'PT', 'PORTUGAL', + 'PR', 'PUERTO RICO', + 'QA', 'QATAR', + 'RE', 'REUNION', + 'RO', 'ROMANIA', + 'RU', 'RUSSIAN FEDERATION', + 'RW', 'RWANDA', + 'KN', 'SAINT KITTS AND NEVIS', + 'LC', 'SAINT LUCIA', + 'VC', 'SAINT VINCENT AND THE GRENADINES', + 'WS', 'SAMOA', + 'SM', 'SAN MARINO', + 'ST', 'SAO TOME AND PRINCIPE', + 'SA', 'SAUDI ARABIA', + 'SN', 'SENEGAL', + 'SC', 'SEYCHELLES', + 'SL', 'SIERRA LEONE', + 'SG', 'SINGAPORE', + 'SK', 'SLOVAKIA (Slovak Republic)', + 'SI', 'SLOVENIA', + 'SB', 'SOLOMON ISLANDS', + 'SO', 'SOMALIA', + 'ZA', 'SOUTH AFRICA', + 'GS', 'SOUTH GEORGIA AND THE SOUTH SANDWICH ISLANDS', + 'ES', 'SPAIN', + 'LK', 'SRI LANKA', + 'SH', 'ST. HELENA', + 'PM', 'ST. PIERRE AND MIQUELON', + 'SD', 'SUDAN', + 'SR', 'SURINAME', + 'SJ', 'SVALBARD AND JAN MAYEN ISLANDS', + 'SZ', 'SWAZILAND', + 'SE', 'SWEDEN', + 'CH', 'SWITZERLAND', + 'SY', 'SYRIAN ARAB REPUBLIC', + 'TW', 'TAIWAN, PROVINCE OF CHINA', + 'TJ', 'TAJIKISTAN', + 'TZ', 'TANZANIA, UNITED REPUBLIC OF', + 'TH', 'THAILAND', + 'TG', 'TOGO', + 'TK', 'TOKELAU', + 'TO', 'TONGA', + 'TT', 'TRINIDAD AND TOBAGO', + 'TN', 'TUNISIA', + 'TR', 'TURKEY', + 'TM', 'TURKMENISTAN', + 'TC', 'TURKS AND CAICOS ISLANDS', + 'TV', 'TUVALU', + 'UG', 'UGANDA', + 'UA', 'UKRAINE', + 'AE', 'UNITED ARAB EMIRATES', + 'GB', 'UNITED KINGDOM', + 'US', 'UNITED STATES', + 'UM', 'UNITED STATES MINOR OUTLYING ISLANDS', + 'UY', 'URUGUAY', + 'UZ', 'UZBEKISTAN', + 'VU', 'VANUATU', + 'VE', 'VENEZUELA', + 'VN', 'VIET NAM', + 'VG', 'VIRGIN ISLANDS (BRITISH)', + 'VI', 'VIRGIN ISLANDS (U.S.)', + 'WF', 'WALLIS AND FUTUNA ISLANDS', + 'EH', 'WESTERN SAHARA', + 'YE', 'YEMEN', + 'YU', 'YUGOSLAVIA', + 'ZM', 'ZAMBIA', + 'ZW', 'ZIMBABWE', + ); + return %Hash; +} + +sub exchange { + my ($message) = @_; + &::DEBUG("exchange(@_)"); + + return 'Exchange.pl needs LWP::UserAgent and HTTP::Request::Common' + if ($no_exchange); + + my ($From, $To, $Amount, $Country); + my $retval = ''; + if ($message =~ /^([\d\.\,]+)\s+(\S+)\s+(?:into|to|for)\s+(\S+)/i) { + ($Amount,$From,$To) = ($1,$2,$3); + $From = uc $From; $To = uc $To; + } elsif ($message =~ /^for\s(?:the\s)?([\w\s]+)/i) { + # looking up the currency for a country + $Country = $1; + } else { + return "that doesn't look right"; + } + + my $ua = new LWP::UserAgent; + # Let's pretend + #$ua->agent('Mozilla/5.0 ' . $ua->agent); + $ua->agent('Mozilla/5.0'); + $ua->proxy('http', $::param{'httpProxy'}) if (&::IsParam('httpProxy')); + $ua->timeout(10); + + my $Referer = 'http://www.xe.net/ucc/full.shtml'; + my $Converter='http://www.xe.net/ucc/convert.cgi'; + + # Get a list of currency abbreviations... + my $grab = GET $Referer; + my $reply = $ua->request($grab); + if (!$reply->is_success) { + return 'EXCHANGE: '.$reply->status_line; + } + my $html = $reply->as_string; + my %Currencies = (grep /\S+/, + ($html =~ /option value="([^"]+)">.*?,\s*([^<]+)([^<]+) 'UTC', + From => $From, + To => $To, + Amount => $Amount, + ]; + + # Falsify where we came from + $req->referer($Referer); + + # Submit request + my $res = $ua->request($req); + + if ($res->is_success) { + # Went through ok + my $html = $res->as_string; + # parse each one to avoid undefined warnings + my ($When) = ($html =~ m/ as of (\d{4}\.\d\d.\d\d\s\d\d:\d\d:\d\d\s\S+)/gi); + my ($Cfrom) = ($html =~ m/(\d[\d,.]+)\s*$From/gi); + my ($Cto) = ($html =~ m/(\d[\d,.]+)\s*$To/gi); + #my ($When, $Cfrom, $Cto) = + # grep /\S+/, ($html =~ m/ as of (\d{4}\.\d\d.\d\d\s\d\d:\d\d:\d\d\s\S+)|(\d[\d,.]+)\s*$From|(\d[\d,.]+)\s* $To/gi); + + if ($When) { + return "$Cfrom $Currencies{$From} makes ". + "$Cto $Currencies{$To} (from http://www.xe.com/)"; # ." ($When)\n"; + } else { + return 'i got some error trying that'; + } + } else { + # Oh dear. + return "EXCHANGE: ". $res->status_line; + } + } else { + return "Don't know about \"$From\" as a currency" if (!exists $Currencies{$From}); + return "Don't know about \"$To\" as a currency" if (!exists $Currencies{$To}); + } + } +} + +sub query { + my ($args) = @_; + &::performStrictReply(&exchange($args)); + return; +} + +#print &exchange('1 usd to eur') . "\n"; +1; + +__END__ + +=head1 NAME + +Exchange.pl - Exchange between currencies + +=head1 PREREQUISITES + + LWP::UserAgent + HTTP::Request::Common + +=head1 PARAMETERS + +exchange + +=head1 PUBLIC INTERFACE + + Exchange for|[in]to + +=head1 DESCRIPTION + +Contacts C and grabs the exchange rates; warning - the +currency code is a bit cranky. + +=head1 AUTHORS + +Bobby diff --git a/src/Modules/Factoids.pl b/src/Modules/Factoids.pl new file mode 100644 index 0000000..89a6934 --- /dev/null +++ b/src/Modules/Factoids.pl @@ -0,0 +1,748 @@ +# +# Factoids.pl: Helpers for generating factoids statistics. +# Author: dms +# Version: v0.1 (20000514) +# Splitted: SQLExtras.pl +# + +use strict; + +use vars qw($dbh $who); +use vars qw(%param); + +### +# Usage: &CmdFactInfo($faqtoid, $query); +sub CmdFactInfo { + my ($faqtoid, $query) = (lc $_[0], $_[1]); + my @array; + my $string = ''; + + if ($faqtoid eq '') { + &help('factinfo'); + return; + } + + my %factinfo = &sqlSelectRowHash('factoids', '*', + { factoid_key => $faqtoid } + ); + + # factoid does not exist. + if (scalar (keys %factinfo) <= 1) { + &performReply("there's no such factoid as \002$faqtoid\002"); + return; + } + + # fix for problem observed by asuffield. + # why did it happen though? + if (!$factinfo{'factoid_value'}) { + &performReply("there's no such factoid as \002$faqtoid\002; deleted because we don't have factoid_value!"); + foreach (keys %factinfo) { + &DEBUG("factinfo{$_} => '$factinfo{$_}'."); + } +### &delFactoid($faqtoid); + return; + } + + # created: + if ($factinfo{'created_by'}) { + + $factinfo{'created_by'} =~ s/\!/ '; + $string = "created by $factinfo{'created_by'}"; + + my $time = $factinfo{'created_time'}; + if ($time) { + if (time() - $time > 60*60*24*7) { + my $days = int( (time() - $time)/60/60/24 ); + $string .= " at \037". scalar(gmtime $time). "\037" . + " ($days days)"; + } else { + $string .= ' '.&Time2String(time() - $time).' ago'; + } + } + + push(@array,$string); + } + + # modified: (TimRiker asks: why do you keep turning this off?) + if ($factinfo{'modified_by'}) { + $string = 'last modified'; + + my $time = $factinfo{'modified_time'}; + if ($time) { + if (time() - $time > 60*60*24*7) { + $string .= " at \037". scalar(gmtime $time). "\037"; + } else { + $string .= ' '.&Time2String(time() - $time).' ago '; + } + } + + $string .= ' by '.(split ',', $factinfo{'modified_by'})[0]; + + push(@array,$string); + } + + # requested: + if ($factinfo{'requested_by'}) { + my $requested_count = $factinfo{'requested_count'}; + + if ($requested_count) { + $string = 'it has been requested '; + if ($requested_count == 1) { + $string .= "\002once\002"; + } else { + $string .= "\002". $requested_count. "\002 ". + &fixPlural('time', $requested_count); + } + + my $requested_by = $factinfo{'requested_by'}; + $requested_by =~ /\!/; + $string .= ", last by $`"; + + my $requested_time = $factinfo{'requested_time'}; + if ($requested_time) { + if (time() - $requested_time > 60*60*24*7) { + $string .= " at \037". scalar(localtime $requested_time). "\037"; + } else { + $string .= ', '.&Time2String(time() - $requested_time).' ago'; + } + } + } else { + $string = 'has not been requested yet'; + } + + push(@array, $string); + } + + # locked: + if ($factinfo{'locked_by'}) { + $factinfo{'locked_by'} =~ /\!/; + $string = "it has been locked by $`"; + + push(@array, $string); + } + + # factoid was inserted not through the bot. + if (!scalar @array) { + &performReply("no extra info on \002$faqtoid\002"); + return; + } + + &performStrictReply("$factinfo{'factoid_key'} -- ". join('; ', @array) .'.'); + return; +} + +sub CmdFactStats { + my ($type) = @_; + + if ($type =~ /^author$/i) { + my %hash = &sqlSelectColHash('factoids', + 'factoid_key,created_by', undef, + 'WHERE created_by IS NOT NULL' + ); + my %author; + + foreach my $factoid (keys %hash) { + my $thisnuh = $hash{$factoid}; + + $thisnuh =~ /^(\S+)!\S+@\S+$/; + $author{lc $1}++; + } + + if (!scalar keys %author) { + return 'sorry, no factoids with created_by field.'; + } + + # work-around. + my %count; + foreach (keys %author) { + $count{ $author{$_} }{$_} = 1; + } + undef %author; + + my $count; + my @list; + foreach $count (sort { $b <=> $a } keys %count) { + my $author = join(', ', sort keys %{ $count{$count} }); + push(@list, "$count by $author"); + } + + my $prefix = 'factoid statistics by author: '; + return &formListReply(0, $prefix, @list); + + } elsif ($type =~ /^vandalism$/i) { + &status('factstats(vandalism): starting...'); + my $start_time = &timeget(); + my %data = &sqlSelectColHash('factoids', + 'factoid_key,factoid_value', undef, + 'WHERE factoid_value IS NOT NULL' + ); + my @list; + + my $delta_time = &timedelta($start_time); + &status(sprintf('factstats(vandalism): %.02f sec to retreive all factoids.', $delta_time)) if ($delta_time > 0); + $start_time = &timeget(); + + # parse the factoids. + foreach (keys %data) { + if (&validFactoid($_, $data{$_}) == 0) { + s/([\,\;]+)/\037$1\037/g; # highlight chars. + push(@list, $_); # push it. + } + } + + $delta_time = &timedelta($start_time); + &status(sprintf('factstats(vandalism): %.02f sec to complete.', $delta_time)) if ($delta_time > 0); + + # bail out on no results. + if (scalar @list == 0) { + return 'no vandalised factoids... wooohoo.'; + } + + # parse the results. + my $prefix = 'Vandalised factoid '; + return &formListReply(1, $prefix, @list); + + } elsif ($type =~ /^total$/i) { + &status('factstats(total): starting...'); + my $start_time = &timeget(); + my @list; + my $str; + my($i,$j); + my %hash; + + ### lets do it. + # total factoids requests. + $i = &sumKey('factoids', 'requested_count'); + push(@list, "total requests - $i"); + + # total factoids modified. + $str = &countKeys('factoids', 'modified_by'); + push(@list, "total modified - $str"); + + # total factoids modified. + $j = &countKeys('factoids', 'requested_count'); + $str = &countKeys('factoids', 'factoid_key'); + push(@list, 'total non-requested - '.($str - $i)); + + # average request/factoid. + # i/j == total(requested_count)/count(requested_count) + $str = sprintf('%.01f', $i/$j); + push(@list, "average requested per factoid - $str"); + + # total prepared for deletion. + $str = scalar( &searchTable('factoids', 'factoid_key', 'factoid_value', ' #DEL') ); + push(@list, "total prepared for deletion - $str"); + + # total unique authors. + # TODO: convert to sqlSelectColHash ? (or ColArray?) + foreach ( &sqlRawReturn('SELECT created_by FROM factoids WHERE created_by IS NOT NULL') ) { + /^(\S+)!/; + my $nick = lc $1; + $hash{$nick}++; + } + push(@list, 'total unique authors - '.(scalar keys %hash) ); + undef %hash; + + # total unique requesters. + foreach ( &sqlRawReturn('SELECT requested_by FROM factoids WHERE requested_by IS NOT NULL') ) { + /^(\S+)!/; + my $nick = lc $1; + $hash{$nick}++; + } + push(@list, 'total unique requesters - '.(scalar keys %hash) ); + undef %hash; + + ### end of 'job'. + + my $delta_time = &timedelta($start_time); + &status(sprintf('factstats(broken): %.02f sec to retreive all factoids.', $delta_time)) if ($delta_time > 0); + $start_time = &timeget(); + + # bail out on no results. + if (scalar @list == 0) { + return 'no broken factoids... wooohoo.'; + } + + # parse the results. + my $prefix = 'General factoid statistics '; + return &formListReply(1, $prefix, @list); + + } elsif ($type =~ /^deadredir$/i) { + my @list = &searchTable('factoids', 'factoid_key', + 'factoid_value', '^ see '); + my %redir; + my $f; + + for (@list) { + my $factoid = $_; + my $val = &getFactInfo($factoid, 'factoid_value'); + if ($val =~ /^ ?see( also)? (.*?)\.?$/i) { + my $redirf = lc $2; + my $redir = &getFactInfo($redirf, 'factoid_value'); + next if (defined $redir); + next if (length $val > 50); + + $redir{$redirf}{$factoid} = 1; + } + } + + my @newlist; + foreach $f (keys %redir) { + my @sublist = keys %{ $redir{$f} }; + for (@sublist) { + s/([\,\;]+)/\037$1\037/g; + } + + push(@newlist, join(', ', @sublist)." => $f"); + } + + # parse the results. + my $prefix = 'Loose link (dead) redirections in factoids '; + return &formListReply(1, $prefix, @newlist); + + } elsif ($type =~ /^dup(licate|e)$/i) { + &status('factstats(dupe): starting...'); + my $start_time = &timeget(); + my %hash = &sqlSelectColHash('factoids', + 'factoid_key,factoid_value', undef, + 'WHERE factoid_value IS NOT NULL', 1 + ); + my $refs = 0; + my @list; + my $v; + + foreach $v (keys %hash) { + my $count = scalar(keys %{ $hash{$v} }); + next if ($count == 1); + + my @sublist; + foreach (keys %{ $hash{$v} }) { + if ($v =~ /^ see /i) { + $refs++; + next; + } + + s/([\,\;]+)/\037$1\037/g; + if ($_ eq '') { + &WARN('dupe: _ = NULL. should never happen!.'); + next; + } + push(@sublist, $_); + } + + next unless (scalar @sublist); + + push(@list, join(', ', @sublist)); + } + + &status("factstats(dupe): (good) dupe refs: $refs."); + my $delta_time = &timedelta($start_time); + &status(sprintf('factstats(dupe): %.02f sec to complete', $delta_time)) if ($delta_time > 0); + + # bail out on no results. + if (scalar @list == 0) { + return 'no duplicate factoids... woohoo.'; + } + + # parse the results. + my $prefix = 'dupe factoid '; + return &formListReply(1, $prefix, @list); + + } elsif ($type =~ /^nullfactoids$/i) { + my $query = "SELECT factoid_key,factoid_value FROM factoids WHERE factoid_value=''"; + my $sth = $dbh->prepare($query); + &ERROR("factstats(null): => '$query'.") unless $sth->execute; + + my @list; + while (my @row = $sth->fetchrow_array) { + if ($row[1] ne '') { + &DEBUG("row[1] != NULL for $row[0]."); + next; + } + + &DEBUG("row[0] => '$row[0]'."); + push(@list, $row[0]); + } + $sth->finish; + + # parse the results. + my $prefix = 'NULL factoids (not deleted yet) '; + return &formListReply(1, $prefix, @list); + + } elsif ($type =~ /^(2|too)short$/i) { + # Custom select statement. + my $query = 'SELECT factoid_key,factoid_value FROM factoids WHERE length(factoid_value) <= 40'; + my $sth = $dbh->prepare($query); + &ERROR("factstats(lame): => '$query'.") unless $sth->execute; + + my @list; + while (my @row = $sth->fetchrow_array) { + my($key,$val) = ($row[0], $row[1]); + my $match = 0; + $match++ if ($val =~ /\s{3,}/); + next unless ($match); + + my $v = &getFactoid($val); + if (defined $v) { + &DEBUG("key $key => $val => $v"); + } + + $key =~ s/\,/\037\,\037/g; + push(@list, $key); + } + $sth->finish; + + # parse the results. + my $prefix = 'Lame factoids '; + return &formListReply(1, $prefix, @list); + + } elsif ($type =~ /^listfix$/i) { + # Custom select statement. + my $query = 'SELECT factoid_key,factoid_value FROM factoids'; + my $sth = $dbh->prepare($query); + &ERROR("factstats(listfix): => '$query'.") unless $sth->execute; + + my @list; + while (my @row = $sth->fetchrow_array) { + my($key,$val) = ($row[0], $row[1]); + my $match = 0; + $match++ if ($val =~ /\S+,? or \S+,? or \S+,? or \S+,?/); + next unless ($match); + + $key =~ s/\,/\037\,\037/g; + push(@list, $key); + $val =~ s/,? or /, /g; + &DEBUG("fixed: => $val."); + &setFactInfo($key,'factoid_value', $val); + } + $sth->finish; + + # parse the results. + my $prefix = 'Inefficient lists fixed '; + return &formListReply(1, $prefix, @list); + + } elsif ($type =~ /^locked$/i) { + my %hash = &sqlSelectColHash('factoids', + 'factoid_key,locked_by', undef, + 'WHERE locked_by IS NOT NULL' + ); + my @list = keys %hash; + + for (@list) { + s/([\,\;]+)/\037$1\037/g; + } + + my $prefix = "factoid statistics on $type "; + return &formListReply(0, $prefix, @list); + + } elsif ($type =~ /^new$/i) { + my %hash = &sqlSelectColHash('factoids', + 'factoid_key,created_time', undef, + 'WHERE created_time IS NOT NULL' + ); + my %age; + + foreach (keys %hash) { + my $created_time = $hash{$_}; + my $delta_time = time() - $created_time; + next if ($delta_time >= 60*60*24); + + $age{$delta_time}{$_} = 1; + } + + if (scalar keys %age == 0) { + return 'sorry, no new factoids.'; + } + + my @list; + foreach (sort {$a <=> $b} keys %age) { + push(@list, join(',', keys %{ $age{$_} })); + } + + my $prefix = 'new factoids in the last 24hours '; + return &formListReply(0, $prefix, @list); + + } elsif ($type =~ /^part(ial)?dupe$/i) { + ### requires 'custom' select statement... oh well... + my $start_time = &timeget(); + + # form length|key and key=length hash list. + &status('factstats(partdupe): forming length hash list.'); + my $query = 'SELECT factoid_key,factoid_value,length(factoid_value) AS length FROM factoids WHERE length(factoid_value) >= 192 ORDER BY length'; + my $sth = $dbh->prepare($query); + &ERROR("factstats(partdupe): => '$query'.") unless $sth->execute; + + my (@key, @list); + my (%key, %length); + while (my @row = $sth->fetchrow_array) { + $length{$row[2]}{$row[0]} = 1; # length(value)|key. + $key{$row[0]} = $row[1]; # key=value. + push(@key, $row[0]); + } + $sth->finish; + &status("factstats(partdupe): total keys => '". scalar(@key) ."'."); + &status('factstats(partdupe): now deciphering data gathered'); + + my @length = sort { $a <=> $b } keys %length; + my $key; + + foreach $key (@key) { + shift @length if (length $key{$key} == $length[0]); + + my $val = quotemeta $key{$key}; + my @sublist; + my $length; + foreach $length (@length) { + foreach (keys %{ $length{$length} }) { + if ($key{$_} =~ /^$val/i) { + s/([\,\;]+)/\037$1\037/g; + s/( and|and )/\037$1\037/g; + push(@sublist,$key.' and '.$_); + } + } + } + push(@list, join(' ,',@sublist)) if (scalar @sublist); + } + + my $delta_time = sprintf('%.02fs', &timedelta($start_time) ); + &status("factstats(partdupe): $delta_time sec to complete.") if ($delta_time > 0); + + # bail out on no results. + if (scalar @list == 0) { + return 'no initial partial duplicate factoids... woohoo.'; + } + + # parse the results. + my $prefix = 'initial partial dupe factoid '; + return &formListReply(1, $prefix, @list); + + } elsif ($type =~ /^profanity$/i) { + my %data = &sqlSelectColHash('factoids', + 'factoid_key,factoid_value', undef, + 'WHERE factoid_value IS NOT NULL' + ); + my @list; + + foreach (keys %data) { + push(@list, $_) if (&hasProfanity($_.' '.$data{$_})); + } + + # parse the results. + my $prefix = 'Profanity in factoids '; + return &formListReply(1, $prefix, @list); + + } elsif ($type =~ /^redir(ection)?$/i) { + my @list = &searchTable('factoids', 'factoid_key', + 'factoid_value', '^ see '); + my %redir; + my $f; + my $dangling = 0; + + for (@list) { + my $factoid = $_; + my $val = &getFactInfo($factoid, 'factoid_value'); + if ($val =~ /^ see( also)? (.*?)\.?$/i) { + my $redir = lc $2; + my $redirval = &getFactInfo($redir, 'factoid_value'); + if (defined $redirval) { + $redir{$redir}{$factoid} = 1; + } else { + &DEBUG("factstats(redir): '$factoid' has loose link => '$redir'."); + $dangling++; + } + } + } + + my @newlist; + foreach $f (keys %redir) { + my @sublist = keys %{ $redir{$f} }; + for (@sublist) { + s/([\,\;]+)/\037$1\037/g; + } + + push(@newlist, "$f => ". join(', ', @sublist)); + } + + # parse the results. + my $prefix = "Redirections in factoids, $dangling dangling "; + return &formListReply(1, $prefix, @newlist); + + } elsif ($type =~ /^request(ed)?$/i) { + my %hash = &sqlSelectColHash('factoids', + 'factoid_key,requested_count', undef, + 'WHERE requested_count IS NOT NULL', 1 + ); + + if (!scalar keys %hash) { + return 'sorry, no factoids have been questioned.'; + } + + my $count; + my @list; + my $total = 0; + foreach $count (sort {$b <=> $a} keys %hash) { + my @faqtoids = sort keys %{ $hash{$count} }; + + for (@faqtoids) { + s/([\,\;]+)/\037$1\037/g; + } + $total += $count * scalar(@faqtoids); + + push(@list, "$count - ". join(', ', @faqtoids)); + } + unshift(@list, "\037$total - TOTAL\037"); + + my $prefix = "factoid statistics on $type "; + return &formListReply(0, $prefix, @list); + + } elsif ($type =~ /^reqrate$/i) { + my %hash = &sqlSelectColHash('factoids', + "factoid_key,(unix_timestamp() - created_time)/requested_count as rate", undef, + 'WHERE requested_by IS NOT NULL and created_time IS NOT NULL ORDER BY rate LIMIT 15', 1 + ); + + my $rate; + my @list; + my $total = 0; + my $users = 0; + foreach $rate (sort { $b <=> $a } keys %hash) { + my $f = join(', ', sort keys %{ $hash{$rate} }); + my $str = "$f - ".&Time2String($rate); + $str =~ s/\002//g; + push(@list, $str); + } + + my $prefix = "Rank of top factoid rate (time/req): "; + return &formListReply(0, $prefix, @list); + + } elsif ($type =~ /^requesters?$/i) { + my %hash = &sqlSelectColHash('factoids', + 'factoid_key,requested_by', undef, + 'WHERE requested_by IS NOT NULL' + ); + my %requester; + + foreach (keys %hash) { + my $thisnuh = $hash{$_}; + + $thisnuh =~ /^(\S+)!\S+@\S+$/; + $requester{lc $1}++; + } + + if (!scalar keys %requester) { + return 'sorry, no factoids with requested_by field.'; + } + + # work-around. + my %count; + foreach (keys %requester) { + $count{ $requester{$_} }{$_} = 1; + } + undef %requester; + + my $count; + my @list; + my $total = 0; + my $users = 0; + foreach $count (sort { $b <=> $a } keys %count) { + my $requester = join(', ', sort keys %{ $count{$count} }); + $total += $count * scalar(keys %{ $count{$count} }); + $users += scalar(keys %{ $count{$count} }); + push(@list, "$count by $requester"); + } + unshift(@list, "\037$total TOTAL REQUESTS; $users UNIQUE REQUESTERS\037"); + # should not the above value be the same as collected by + # 'requested'? soemthing weird is going on! + + my $prefix = 'rank of top factoid requesters: '; + return &formListReply(0, $prefix, @list); + + } elsif ($type =~ /^seefix$/i) { + my @list = &searchTable('factoids', 'factoid_key', + 'factoid_value', '^see '); + my @newlist; + my $fixed = 0; + my %loop; + my $f; + + for (@list) { + my $factoid = $_; + my $val = &getFactInfo($factoid, 'factoid_value'); + + next unless ($val =~ /^see( also)? (.*?)\.?$/i); + + my $redirf = lc $2; + my $redir = &getFactInfo($redirf, 'factoid_value'); + + if ($redirf =~ /^\Q$factoid\W$/i) { + &delFactoid($factoid); + $loop{$factoid} = 1; + } + + if (defined $redir) { # good. + &setFactInfo($factoid,'factoid_value'," see $redir"); + $fixed++; + } else { + push(@newlist, $redirf); + } + } + + # parse the results. + &msg($who, "Fixed $fixed factoids."); + &msg($who, 'Self looped factoids removed: '. keys %loop ) if (scalar keys %loop); + + my $prefix = "Loose link (dead) redirections in factoids "; + return &formListReply(1, $prefix, @newlist); + + } elsif ($type =~ /^(2|too)long$/i) { + my @list; + my $query; + + # factoid_key. + $query = "SELECT factoid_key FROM factoids WHERE length(factoid_key) >= $param{'maxKeySize'}"; + my $sth = $dbh->prepare($query); + $sth->execute; + while (my @row = $sth->fetchrow_array) { + push(@list,$row[0]); + } + $sth->finish; + + # factoid_value. + $query = "SELECT factoid_key,factoid_value FROM factoids WHERE length(factoid_value) >= $param{'maxDataSize'}"; + $sth = $dbh->prepare($query); + $sth->execute; + while (my @row = $sth->fetchrow_array) { + push(@list,sprintf("\002%s\002 - %s", length($row[1]), $row[0])); + } + $sth->finish; + + if (scalar @list == 0) { + return 'good. no factoids exceed length.'; + } + + # parse the results. + my $prefix = 'factoid key||value exceeding length '; + return &formListReply(1, $prefix, @list); + + } elsif ($type =~ /^unrequest(ed)?$/i) { + # TODO: use sqlSelect() + my ($count) = &sqlRawReturn("SELECT COUNT(*) FROM factoids WHERE requested_count = '0'"); + + return "Unrequested factoids: $count"; + } + + return "error: invalid type => '$type'."; +} + +sub CmdListAuth { + my ($query) = @_; + my $maxshow = &::getChanConfDefault('maxListReplyCount', 15, $chan); + my @list = &searchTable('factoids','factoid_key', 'created_by', "^$query!"); + @list=grep(!/\#DEL\#$/,@list) if (scalar(@list) > $maxshow); + + my $prefix = "factoid author list by '$query' "; + &performStrictReply( &formListReply(1, $prefix, @list) ); +} + +1; diff --git a/src/Modules/HTTPDtype.pl b/src/Modules/HTTPDtype.pl new file mode 100644 index 0000000..5906077 --- /dev/null +++ b/src/Modules/HTTPDtype.pl @@ -0,0 +1,33 @@ +# HTTPDtype.pl: retrieves http server headers +# Author: Joey Smith +# Licensing: Artistic License +# Version: v0.1 (20031110) +# +use strict; + +package HTTPDtype; + +sub HTTPDtype { + my($HOST) = @_; + my($line) = ''; + my($code, $mess, %h); + + # TODO: remove leading http:// and trailing :port and /foo if found + $HOST = 'joeysmith.com' unless length($HOST) > 0; + return unless &::loadPerlModule("Net::HTTP::NB"); + return unless &::loadPerlModule("IO::Select"); + + my $s = Net::HTTP::NB->new(Host => $HOST) || return; + $s->write_request(HEAD => "/"); + + my $sel = IO::Select->new($s); + $line = 'Header timeout' unless $sel->can_read(10); + ($code, $mess, %h) = $s->read_response_headers; + + $line = (length($h{Server}) > 0) ? $h{Server} : + "Couldn't fetch headers from $HOST"; + + &::performStrictReply($line||'Unknown Error Condition'); +} + +1; diff --git a/src/Modules/Kernel.pl b/src/Modules/Kernel.pl new file mode 100644 index 0000000..2b0ba90 --- /dev/null +++ b/src/Modules/Kernel.pl @@ -0,0 +1,93 @@ +# +# Kernel.pl: Frontend to linux.kernel.org. +# Author: dms +# Version: v0.3 (19990919). +# Created: 19990729 +# + +package Kernel; + +sub kernelGetInfo { + return &::getURL("http://www.kernel.org/kdist/finger_banner"); +} + +sub Kernel { + my $retval = 'Linux kernel versions'; + my @now = &kernelGetInfo(); + if (!scalar @now) { + &::msg($::who, "failed."); + return; + } + + foreach $line (@now) { + $line =~ s/The latest //; + $line =~ s/version //; + $line =~ s/of //; + $line =~ s/the //; + $line =~ s/Linux //; + $line =~ s/kernel //; + $line =~ s/tree //; + $line =~ s/ for stable//; + $line =~ s/ to stable kernels//; + $line =~ s/ for 2.4//; + $line =~ s/ for 2.2//; + $line =~ s/ is: */: /; + $retval .= ', ' . $line; + } + &::performStrictReply($retval); +} + +sub kernelAnnounce { + my $file = "$::param{tempDir}/kernel.txt"; + my @now = &kernelGetInfo(); + my @old; + + if (!scalar @now) { + &::DEBUG('kA: failure to retrieve.'); + return; + } + + if (! -f $file) { + open(OUT, ">$file"); + foreach (@now) { + print OUT "$_\n"; + } + close OUT; + + return; + } else { + open(IN, $file); + while () { + chop; + push(@old,$_); + } + close IN; + } + + my @new; + for(my $i=0; $i$file"); + foreach (@now) { + print OUT "$_\n"; + } + close OUT; + + return @new; +} + +1; diff --git a/src/Modules/Math.pl b/src/Modules/Math.pl new file mode 100644 index 0000000..32350ff --- /dev/null +++ b/src/Modules/Math.pl @@ -0,0 +1,140 @@ +# +# infobot copyright (C) kevin lenzo 1997-98 +# + +use strict; + +use vars qw($message); + +my %digits = ( + 'first', '1', + 'second', '2', + 'third', '3', + 'fourth', '4', + 'fifth', '5', + 'sixth', '6', + 'seventh', '7', + 'eighth', '8', + 'ninth', '9', + 'tenth', '10', + 'one', '1', + 'two', '2', + 'three', '3', + 'four', '4', + 'five', '5', + 'six', '6', + 'seven', '7', + 'eight', '8', + 'nine', '9', + 'ten', '10' +); + +sub perlMath { + my($locMsg) = $message; + + if ($message =~ /^\s*$/) { + return; + } + + foreach (keys %digits) { + $locMsg =~ s/$_/$digits{$_}/g; + } + + while ($locMsg =~ /(exp ([\w\d]+))/) { + my($exp, $val) = ($1, exp $2); + $locMsg =~ s/$exp/+$val/g; + } + + while ($locMsg =~ /(hex2dec\s*([0-9A-Fa-f]+))/) { + my($exp, $val) = ($1, hex $2); + $locMsg =~ s/$exp/+$val/g; + } + + if ($locMsg =~ /^\s*(dec2hex\s*(\d+))\s*\?*/) { + my ($exp, $val) = ($1, sprintf("%x", "$2")); + $locMsg =~ s/$exp/+$val/g; + } + + my $e = exp(1); + $locMsg =~ s/\be\b/$e/; + + while ($locMsg =~ /(log\s*((\d+\.?\d*)|\d*\.?\d+))\s*/) { + my ($exp, $res) = ($1, $2); + my $val = ($res) ? log($res) : 'Infinity'; + $locMsg =~ s/$exp/+$val/g; + } + + while ($locMsg =~ /(bin2dec ([01]+))/) { + my $exp = $1; + my $val = join ('', unpack('B*',$2)) ; + $locMsg =~ s/$exp/+$val/g; + } + + while ($locMsg =~ /(dec2bin (\d+))/) { + my $exp = $1; + my $val = join('', unpack('B*', pack('N',$2))); + $val =~ s/^0+//; + $locMsg =~ s/$exp/+$val/g; + } + + for ($locMsg) { + s/\bpi\b/3.14159265/g; + s/ to the / ** /g; + s/\btimes\b/\*/g; + s/\bdiv(ided by)? /\/ /g; + s/\bover /\/ /g; + s/\bsquared/\*\*2 /g; + s/\bcubed/\*\*3 /g; + s/\bto\s+(\d+)(r?st|nd|rd|th)?( power)?/\*\*$1 /ig; + s/\bpercent of/*0.01*/ig; + s/\bpercent/*0.01/ig; + s/\% of\b/*0.01*/g; + s/\%/*0.01/g; + s/\bsquare root of (\d+)/$1 ** 0.5 /ig; + s/\bcubed? root of (\d+)/$1 **(1.0\/3.0) /ig; + s/ of / * /; + s/(bit(-| )?)?xor(\'?e?d( with))?/\^/g; + s/(bit(-| )?)?or(\'?e?d( with))?/\|/g; + s/bit(-| )?and(\'?e?d( with))?/\& /g; + s/(plus|and)/+/ig; + } + + # what the hell is this shit? + if (($locMsg =~ /^\s*[-\d*+\s()\/^\.\|\&\*\!]+\s*$/) + && ($locMsg !~ /^\s*\(?\d+\.?\d*\)?\s*$/) + && ($locMsg !~ /^\s*$/) + && ($locMsg !~ /^\s*[( )]+\s*$/) + && ($locMsg =~ /\d+/) + ) { + $locMsg =~ s/([0-9]+\.[0-9]+(\.[0-9]+)+)/"$1"/g; + $locMsg = eval($locMsg); + + if (defined $locMsg and $locMsg =~ /^[-+\de\.]+$/) { + $locMsg = sprintf("%1.12f", $locMsg); + $locMsg =~ s/\.?0+$//; + + if (length $locMsg > 30) { + $locMsg = "a number with quite a few digits..."; + } + } else { + if (defined $locMsg) { + &FIXME("math: locMsg => '$locMsg'..."); + } else { + &status("math: could not really compute."); + $locMsg = ''; + } + } + } else { + $locMsg = ''; + } + + if (defined $locMsg and $locMsg ne $message) { + # success. + return $locMsg; + } else { + # no match. + return ''; + } +} + +1; diff --git a/src/Modules/News.pl b/src/Modules/News.pl new file mode 100644 index 0000000..4af400b --- /dev/null +++ b/src/Modules/News.pl @@ -0,0 +1,1030 @@ +# +# News.pl: Advanced news management +# Author: dms +# Version: v0.3 (20010412) +# Created: 20010326 +# Notes: Testing done by greycat, kudos! +# +### structure: +# news{ channel }{ string } { item } +# newsuser{ channel }{ user } = time() +### where item is: +# Time - when it was added (used for sorting) +# Author - Who by. +# Expire - Time to expire. +# Text - Actual text. +### + +package News; + +use strict; + +use vars qw($who $chan); + +sub Parse { + my($what) = @_; + $chan = undef; + $who = lc $::who; + + if (!keys %::news) { + if (!exists $::cache{newsFirst}) { + &::DEBUG("news: looks like we enabled news option just then; loading up news file just in case."); + $::cache{newsFirst} = 1; + } + + &readNews(); + } + + if ($::msgType ne 'private') { + $chan = $::chan; + } + + if (defined $what and $what =~ s/^($::mask{chan})\s*//) { + # TODO: check if the channel exists aswell. + $chan = lc $1; + + if (!&::IsNickInChan($who, $chan)) { + &::notice($who, "sorry but you're not on $chan."); + return; + } + } + + if (!defined $chan) { + my @chans = &::getNickInChans($who); + + if (scalar @chans > 1) { + &::notice($who, "error: I dunno which channel you are referring to since you're on more than one. Try 'news #chan ...' instead"); + return; + } + + if (scalar @chans == 0) { + &::notice($who, "error: I couldn't find you on any chan. This must be a bug!"); + return; + } + + $chan = $chans[0]; + &::VERB("Guessed $who being on chan $chan",2); + $::chan = $chan; # hack for IsChanConf(). + } + + if (!defined $what or $what =~ /^\s*$/) { + &list(); + return; + } + + if ($what =~ /^add(\s+(.*))?$/i) { + &add($2); + + } elsif ($what =~ /^del(\s+(.*))?$/i) { + &del($2); + + } elsif ($what =~ /^mod(\s+(.*))?$/i) { + &mod($2); + + } elsif ($what =~ /^set(\s+(.*))?$/i) { + &set($2); + + } elsif ($what =~ /^(\d+)$/i) { + &::VERB("News: read shortcut called.",2); + &read($1); + + } elsif ($what =~ /^read(\s+(.*))?$/i) { + &read($2); + + } elsif ($what =~ /^(latest|new)(\s+(.*))?$/i) { + &latest($3 || $chan, 1); +# $::cmdstats{'News latest'}++; + + } elsif ($what =~ /^stats?$/i) { + &stats(); + + } elsif ($what =~ /^list$/i) { + &list(); + + } elsif ($what =~ /^(expire|text|desc)(\s+(.*))?$/i) { + # shortcut/link. + # nice hack. + my $cmd = $1; + my($arg1,$arg2) = split(/\s+/, $3, 2); + &set("$arg1 $cmd $arg2"); + + } elsif ($what =~ /^help(\s+(.*))?$/i) { + &::help("news $2"); + + } elsif ($what =~ /^newsflush$/i) { + &::msg($who, "newsflush called... check out the logs!"); + &::newsFlush(); + + } elsif ($what =~ /^(un)?notify$/i) { + my $state = ($1) ? 0 : 1; + + # TODO: don't notify even if 'News' is called. + if (&::IsChanConf('newsNotifyAll') <= 0) { + &::DEBUG("news: chan => $chan, ::chan => $::chan."); + &::notice($who, "not available for this channel or disabled altogether."); + return; + } + + my $t = $::newsuser{$chan}{$who}; + if ($state) { # state = 1 + if (defined $t and ($t == 0 or $t == -1)) { + &::notice($who, "enabled notify."); + delete $::newsuser{$chan}{$who}; + return; + } + &::notice($who, "already enabled."); + + } else { # state = 0 + my $x = $::newsuser{$chan}{$who}; + if (defined $x and ($x == 0 or $x == -1)) { + &::notice($who, 'notify already disabled'); + return; + } + $::newsuser{$chan}{$who} = -1; + &::notice($who, "notify is now disabled."); + } + + } else { + &::notice($who, "unknown command: $what"); + } +} + +sub readNews { + my $file = "$::bot_base_dir/infobot-news.txt"; + if (! -f $file or -z $file) { + return; + } + + if (fileno NEWS) { + &::DEBUG("readNews: fileno exists, should never happen."); + return; + } + + my($item,$chan); + my($ci,$cu) = (0,0); + + open(NEWS, $file); + while () { + chop; + + # TODO: allow commands. + + if (/^[\s\t]+(\S+):[\s\t]+(.*)$/) { + if (!defined $item) { + &::DEBUG("news: !defined item, never happen!"); + next; + } + + $::news{$chan}{$item}{$1} = $2; + next; + } + + # U