--- /dev/null
+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'.
+ - ...
+
+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 <nick>'
+ => 'uinfo set <type> <what>'
+ => 'uinfo unset <type>'
+ - 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 '<REPLY> 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 <who> about <what>' 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 <REPLY> 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.
--- /dev/null
+Method of installation.
+-----------------------
+
+- Move infobot.config to infobot.config.used
+- Copy samle.config to infobot.config
+- Edit files/infobot.config, modify to taste.
+- Edit files/ircII.server to modify list of IRC servers to connect.
+- Depends on:
+ - 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-parse-perl)
+
+- Choice of database
+ - MySQL (see INSTALL.mysql)
+ - PgSQL (see INSTALL.pgsql, DOES NOT WORK YET)
+ - Berkeley DBM (see INSTALL.dbm)
+
+[OPTIONAL,FIXME]
+- 'scripts/insertDB.pl files/sample.insert'.
+
+- There are "bugs" in the perl modules. (see INSTALL.patches) on how to
+ fix.
+
+- Finally, './infobot'
--- /dev/null
+INSTALLATION of dbm
+----------------------
+
+- perl5.004 uses dbm1.85 while perl5.005 uses dbm2.00. Attempting to
+ interchange dbm between the two will result in corruption.
+- the dbm will produce two files of the same size (for some reason)
+- If the bot crashes, the dbm file may increase in size dramatically, from
+ 900k-1400k to 16m-24m
+- dbm is a slow but simple form of db. If you want performance, try mysql
+ or pgsql (NOT YET)
+
+= To convert dbm file to mysql table:
+ - run 'scripts/dbm2mysql.pl old-db' to convert dbm database file
+ to mysql.
--- /dev/null
+INSTALL.mysql
+----------------
+
+- Debian: (apt-get install mysql-server)
+- Debian: (apt-get install libdbd-mysql-perl)
+
+- run 'mysqladmin -u root -p create <DB NAME>'
+- run 'scripts/setup_user.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'
+- run 'scripts/setup_tables.pl'
+* [OPTIONAL]
+ - run 'scripts/dbm2mysql.pl old-db' to convert dbm database file
+ to mysql.
--- /dev/null
+INSTALL.patches
+-------------------
+
+- apply *.patch patches from docs/ ( DOES THIS WORK???)
+ - cd /usr/lib/perl5/Net
+ patch -p0 < Net::IRC.patch
+ - cd /usr/lib/perl5/WWW/Search
+ patch -p0 < WWW::Search::Google.patch
--- /dev/null
+Method of installation.
+-----------------------
+
+- Debian: (apt-get install postgresql)
+- Debian: (apt-get install libpgperl)
+
+- run 'scripts/setup_user.pl'
+- run 'scripts/setup_tables.pl'
--- /dev/null
+19777.679 running blootbot 1.0.0 (20000725) -- linux, ended Wed Jul 26 14:35:05 2000
+18246.691 running blootbot 1.0.0 (20000725) -- linux, ended Wed Jul 26 14:09:34 2000
+17913.859 running blootbot 1.0.0 (20000725) -- linux, ended Wed Jul 26 19:33:39 2000
--- /dev/null
+blootbot v1.0.0RC3 (20000709)
+-------------------------
+
+INTRODUCTION
+ This bot is based upon infobot-0.44.2 by kevin lenzo
+<lenzo@cs.cmu.edu>. 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.
+
+ 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.
+
+UPDATE:
+ 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.
+
+ Please apply the patches from patches/*.patch. Method:
+ cd /usr/lib/perl5
+ cat *.patch | patch -p0
+ ### FIXME: what's the best way to apply patches?
+ ### for the time being, patch manually.
+
+ 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.
+
+ a few guys from #debian@OPN are attempting to rewrite the bot in C
+to support dbm185or2//mysql//postgresql. It's available at
+ftp://leguin.org.uk/pub/bloatbot/
+
+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.
+
+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 <topic> - Append <topic> 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> <type> <2> - <type>:
+ 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 <param> <value> -- ...
+ unset <param> -- ...
+
+
+INSTALLATION
+ edit files/infobot.config and modify according to needs.
+
+
+NOTES
+ To administrate/control the bot remotely, this can only be done
+through DCC CHAT. /chat <BOT NICK>. 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/DBM 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 sent me a patch to clean up behaviour of factoids
+(adding,removing, modifying). Thanks.
+
+
+CONTACT
+ Contributions of a patch or a job offer can be sent to
+<xk@leguin.openprojects.net>
--- /dev/null
+ The latest stable version of the Linux kernel is: 2.2.16
+ The latest beta version of the Linux kernel is: 2.4.0-test4
+ The latest prepatch (alpha) version *appears* to be: 2.4.0-test5/pre6
--- /dev/null
+<?xml version="1.0"?><backslash
+xmlns:backslash="http://slashdot.org/backslash.dtd">
+
+ <story>
+ <title>Napster Shut Down Until Trial</title>
+ <url>http://slashdot.org/article.pl?sid=00/07/26/2357235</url>
+ <time>2000-07-26 23:57:08</time>
+ <author>CmdrTaco</author>
+ <department>so-google-is-next-then-right?</department>
+ <topic>news</topic>
+ <comments>0</comments>
+ <section>articles</section>
+ <image>topicnews.gif</image>
+ </story>
+
+ <story>
+ <title>Peeking At The Future: "Perfect Mirror" Cables</title>
+ <url>http://slashdot.org/article.pl?sid=00/07/26/1717235</url>
+ <time>2000-07-26 23:06:10</time>
+ <author>timothy</author>
+ <department>unless-this-is-completely-made-up</department>
+ <topic>tech</topic>
+ <comments>67</comments>
+ <section>articles</section>
+ <image>topictech2.jpg</image>
+ </story>
+
+ <story>
+ <title>Kuro5hin - Bitter and Hopeful</title>
+ <url>http://slashdot.org/article.pl?sid=00/07/26/2027241</url>
+ <time>2000-07-26 21:00:20</time>
+ <author>emmett</author>
+ <department>we-love-you-guys</department>
+ <topic>internet</topic>
+ <comments>248</comments>
+ <section>features</section>
+ <image>topicinternet.gif</image>
+ </story>
+
+ <story>
+ <title>GTK-Themes To Be Supported By KDE2</title>
+ <url>http://slashdot.org/article.pl?sid=00/07/26/1847224</url>
+ <time>2000-07-26 18:46:32</time>
+ <author>Hemos</author>
+ <department>here's-something-for-your-eye-dekker</department>
+ <topic>kde</topic>
+ <comments>148</comments>
+ <section>articles</section>
+ <image>topickde.gif</image>
+ </story>
+
+ <story>
+ <title>G4 Powerbooks Predicted For January 2001</title>
+ <url>http://slashdot.org/article.pl?sid=00/07/26/053210</url>
+ <time>2000-07-26 17:51:20</time>
+ <author>timothy</author>
+ <department>by-which-point-transmeta-etc-etc</department>
+ <topic>apple</topic>
+ <comments>219</comments>
+ <section>articles</section>
+ <image>topicapple.gif</image>
+ </story>
+
+ <story>
+ <title>Two-Faced Napster?</title>
+ <url>http://slashdot.org/article.pl?sid=00/07/26/1647242</url>
+ <time>2000-07-26 16:47:15</time>
+ <author>Hemos</author>
+ <department>fun-thought-experiments</department>
+ <topic>music</topic>
+ <comments>291</comments>
+ <section>articles</section>
+ <image>topicmusic.gif</image>
+ </story>
+
+ <story>
+ <title>Inside Echelon</title>
+ <url>http://slashdot.org/article.pl?sid=00/07/26/1217248</url>
+ <time>2000-07-26 14:59:39</time>
+ <author>CmdrTaco</author>
+ <department>fodder-for-the-conspiracy-theorists</department>
+ <topic>Privacy</topic>
+ <comments>202</comments>
+ <section>yro</section>
+ <image>topicprivacy.gif</image>
+ </story>
+
+ <story>
+ <title>SETI Accelerator Hoax Revealed</title>
+ <url>http://slashdot.org/article.pl?sid=00/07/26/1159231</url>
+ <time>2000-07-26 13:58:36</time>
+ <author>Hemos</author>
+ <department>well-duh</department>
+ <topic>tech</topic>
+ <comments>299</comments>
+ <section>articles</section>
+ <image>topictech2.jpg</image>
+ </story>
+
+ <story>
+ <title>MPAA v. 2600 NY Trial Has Ended</title>
+ <url>http://slashdot.org/article.pl?sid=00/07/26/1317255</url>
+ <time>2000-07-26 13:16:53</time>
+ <author>Hemos</author>
+ <department>continue-to-fight-the-good-fight</department>
+ <topic>doj</topic>
+ <comments>407</comments>
+ <section>yro</section>
+ <image>topicdoj.jpg</image>
+ </story>
+
+ <story>
+ <title>IBM Does Bluetooth On Linux</title>
+ <url>http://slashdot.org/article.pl?sid=00/07/26/1219224</url>
+ <time>2000-07-26 12:18:59</time>
+ <author>CmdrTaco</author>
+ <department>wouldn't-it-be-nice</department>
+ <topic>linux</topic>
+ <comments>49</comments>
+ <section>articles</section>
+ <image>topiclinux.gif</image>
+ </story>
+
+</backslash>
--- /dev/null
+ KNOWN PROBLEMS AND BUGS
+
+Problem #1:
+ 'topic [#channel] shuffle' will produce 1 in n! (where n
+ is number of subtopics in topic. IS THIS CORRECT PROBABILITY?)
+ chance that it will be the same as before.
+
+ If someone wants to experiment a fix for this, do so.
+ Here is a hint:
+ 'while (!defined $newtopic || $topic{$talkchannel} eq $newtopic) {'
+
+Problem #2: [UPDATED 20000224]
+ A race condition is observed if the topic is changed very
+ quickly. If the bot is told to change the topic twice but
+ has not received notification of the new topic before
+ changing to the second modification of the topic, it
+ would use the absolute first (0) topic as a reference,
+ therefore missing out on the first alteration of the
+ topic.
+
+ A very cheap solution exists. Edit IrcHooks.pl, search for
+ 'topic', alter '1' to '0'. This will only cache topics made by the
+ bot (I hope). I have a faint feeling that bot-only topics are
+ stored elsewhere (history I think) but I'm not quite sure.
+
+ Yet another (ultimate and preferable) solution would be to have
+ topic queueing, altering the topic once the first alteration has
+ been done, changing the topic until the queue is empty. However,
+ topic floods will eventuate unfortunately. If a queue of 2 or more
+ is detected, no more topic changes are done until a time of
+ 5-10seconds (how can this be done?). This is a challenge to
+ implement.
+
+Problem #3: 19991110
+ It appears that if the last string separated by a whitespace
+ of the topic will be chopped off (if it's "()") because the
+ ownership is null. At first I thought it was a bug in the regex
+ but it was okay. I guess it's a minor problem but why should
+ there be a semi-ownerless subtopic :) If it's annoying, please
+ investigate the &topicCipher() function in Topic.pl in relation to
+ &topicDecipher().
+
+Problem #4: 199912xx
+ mysql overload...
+
+ DBD::mysql::st execute failed: Duplicate entry 'xk' for key 1 at
+ ./src/Freshmeat.pl line 85.
+ when freshmeat.pl is building the table and something's said in the
+ channel... seen code tries to update table but fails.
+
+ [UPDATE 20000224]
+ This may be eliminated by reducing 4-5 INSERT/UPDATE requests to
+ just 1 (total of 2), depending on the return of SELECT. If this
+ still persists and memory leaks are happening, first make
+ sure you are not using broken mysql tables, secondly bitch at the
+ mysql-perl author that there is a memory leak when a broken table
+ is in use.
+
+Problem #5:
+ doWarn is called when perl catches a "warning".
+
+ =>
+ [ 44] !WARN! PERL: Use of uninitialized value at ./src/Modules.pl line 316.
+ [ 45] !WARN! PERL: offending line => ' if ($query eq "") {'.
+ [ 46] !DEBUG! test1.
+ [ 47] !DEBUG! test2.
+ [ 48] !DEBUG! test3.
+
+ ### From 'perlfunc'...
+ Note that this is quite safe and will not produce an endless loop,
+ since __WARN__ hooks are not called from inside one.
+
+ ### From 'perlvar'...
+ Note that __DIE__/__WARN__ handlers are very special in one
+ respect: they may be called to report (probable) errors found by
+ the parser. In such a case the parser may be in inconsistent
+ state, so any attempt to evaluate Perl code from such a handler
+ will probably result in a segfault.
+
+Problem #6:
+! 14! Debian: 12.87 sec to complete query.
+! 15! </#debian-bots> Debian Search of 'testing' (2 shown): ...
+[ 38] disconnect from irc.home.org (Connection reset by peer).
+[ 39] reconnection... cleaning out channel cache.
+
+ Solution #6:
+ Edit /usr/lib/perl5/Net/IRC.pm
+ Comment out *->quit() on 'sub DESTROY'
+ Alternatively, bitch at author of Net::IRC.
+
+Problem #7: why...
+ <\ifvoid> apt, cellwave?
+ <apt> i haven't a clue, \ifvoid
+ <tapt> bugger all, i dunno, \ifvoid
+
+Problem #8:
+ <egamI-rorriM> apt: lart
+ * apt/#debian strangles with a doohicky mouse cord
+
+Problem #9:
+ [Flugh] i say 'rom, rom is a mud server', it says 'ok'. then
+ 'rom, rom?' it says 'yes? <nick>'
+
+# info package dist doesn't recognise dist.
--- /dev/null
+#####################################################################
+# #
+# Net::IRC -- Object-oriented Perl interface to an IRC server #
+# #
+# Connection.pm: The basic functions for a simple IRC connection #
+# #
+# #
+# Copyright (c) 1997 Greg Bacon & Dennis Taylor. #
+# All rights reserved. #
+# #
+# This module is free software; you can redistribute or #
+# modify it under the terms of Perl's Artistic License. #
+# #
+#####################################################################
+# $Id$
+
+
+package Net::IRC::Connection;
+
+use Net::IRC::Event;
+use Net::IRC::DCC;
+use Socket;
+use Symbol;
+use Carp;
+use strict; # A little anal-retention never hurt...
+use vars ( # with a few exceptions...
+ '$AUTOLOAD', # - the name of the sub in &AUTOLOAD
+ '%_udef', # - the hash containing the user's global handlers
+ '%autoloaded', # - the hash containing names of &AUTOLOAD methods
+ );
+
+
+# The names of the methods to be handled by &AUTOLOAD.
+# It seems the values ought to be useful *somehow*...
+my %autoloaded = (
+ 'ircname' => undef,
+ 'port' => undef,
+ 'username' => undef,
+ 'socket' => undef,
+ 'verbose' => undef,
+ 'parent' => undef,
+ );
+
+# This hash will contain any global default handlers that the user specifies.
+
+my %_udef = ();
+
+
+
+#####################################################################
+# Methods start here, arranged in alphabetical order. #
+#####################################################################
+
+
+# This sub is the common backend to add_handler and add_global_handler
+#
+sub _add_generic_handler
+{
+ my ($self, $event, $ref, $rp, $hash_ref, $real_name) = @_;
+ my $ev;
+ my %define = ( "replace" => 0, "before" => 1, "after" => 2 );
+
+ unless (@_ >= 3) {
+ croak "Not enough arguments to $real_name()";
+ }
+ unless (ref($ref) eq 'CODE') {
+ croak "Second argument of $real_name isn't a coderef";
+ }
+
+ # Translate REPLACE, BEFORE and AFTER.
+ if (not defined $rp) {
+ $rp = 0;
+ } elsif ($rp =~ /^\D/) {
+ $rp = $define{lc $rp} || 0;
+ }
+
+ foreach $ev (ref $event eq "ARRAY" ? @{$event} : $event) {
+ # Translate numerics to names
+ if ($ev =~ /^\d/) {
+ $ev = Net::IRC::Event->trans($ev);
+ unless ($ev) {
+ carp "Unknown event type in $real_name: $ev";
+ return;
+ }
+ }
+
+ $hash_ref->{lc $ev} = [ $ref, $rp ];
+ }
+ return 1;
+}
+
+# This sub will assign a user's custom function to a particular event which
+# might be received by any Connection object.
+# Takes 3 args: the event to modify, as either a string or numeric code
+# If passed an arrayref, the array is assumed to contain
+# all event names which you want to set this handler for.
+# a reference to the code to be executed for the event
+# (optional) A value indicating whether the user's code should replace
+# the built-in handler, or be called with it. Possible values:
+# 0 - Replace the built-in handlers entirely. (the default)
+# 1 - Call this handler right before the default handler.
+# 2 - Call this handler right after the default handler.
+# These can also be referred to by the #define-like strings in %define.
+sub add_global_handler {
+ my ($self, $event, $ref, $rp) = @_;
+ return $self->_add_generic_handler($event, $ref, $rp,
+ \%_udef, 'add_global_handler');
+}
+
+# This sub will assign a user's custom function to a particular event which
+# this connection might receive. Same args as above.
+sub add_handler {
+ my ($self, $event, $ref, $rp) = @_;
+ return $self->_add_generic_handler($event, $ref, $rp,
+ $self->{_handler}, 'add_handler');
+}
+
+# -- #perl was here! --
+# fimmtiu: Oh, dear. There actually _is_ an alt.fan.jwz.
+# Freiheit: "Join us. *whapdewhapwhap* Join us now. *whapdewhapwhap* Join
+# us now and share the software."
+# Freiheit: is that actually RMS singing or is it a voice-synthesizer?
+
+
+# Why do I even bother writing subs this simple? Sends an ADMIN command.
+# Takes 1 optional arg: the name of the server you want to query.
+sub admin {
+ my $self = shift; # Thank goodness for AutoLoader, huh?
+ # Perhaps we'll finally use it soon.
+
+ $self->sl("ADMIN" . ($_[0] ? " $_[0]" : ""));
+}
+
+# Takes care of the methods in %autoloaded
+# Sets specified attribute, or returns its value if called without args.
+sub AUTOLOAD {
+ my $self = @_; ## can't modify @_ for goto &name
+ my $class = ref $self; ## die here if !ref($self) ?
+ my $meth;
+
+ # -- #perl was here! --
+ # <Teratogen> absolute power corrupts absolutely, but it's a helluva lot
+ # of fun.
+ # <Teratogen> =)
+
+ ($meth = $AUTOLOAD) =~ s/^.*:://; ## strip fully qualified portion
+
+ unless (exists $autoloaded{$meth}) {
+ croak "No method called \"$meth\" for $class object.";
+ }
+
+ eval <<EOSub;
+sub $meth {
+ my \$self = shift;
+
+ if (\@_) {
+ my \$old = \$self->{"_$meth"};
+
+ \$self->{"_$meth"} = shift;
+
+ return \$old;
+ }
+ else {
+ return \$self->{"_$meth"};
+ }
+}
+EOSub
+
+ ## no reason to play this game every time
+ goto &$meth;
+}
+
+
+# Toggles away-ness with the server. Optionally takes an away message.
+sub away {
+ my $self = shift;
+ $self->sl("AWAY" . ($_[0] ? " :$_[0]" : ""));
+}
+
+
+# -- #perl was here! --
+# <crab> to irc as root demonstrates about the same brains as a man in a
+# thunderstorm waving a lightning rod and standing in a copper tub
+# of salt water yelling "ALL GODS ARE BASTARDS!"
+# DrForr saves that one.
+
+# Attempts to connect to the specified IRC (server, port) with the specified
+# (nick, username, ircname). Will close current connection if already open.
+sub connect {
+ my $self = shift;
+ my ($hostname, $password, $sock);
+
+ if (@_) {
+ my (%arg) = @_;
+
+ $hostname = $arg{'LocalAddr'} if exists $arg{'LocalAddr'};
+ $password = $arg{'Password'} if exists $arg{'Password'};
+ $self->nick($arg{'Nick'}) if exists $arg{'Nick'};
+ $self->port($arg{'Port'}) if exists $arg{'Port'};
+ $self->server($arg{'Server'}) if exists $arg{'Server'};
+ $self->ircname($arg{'Ircname'}) if exists $arg{'Ircname'};
+ $self->username($arg{'Username'}) if exists $arg{'Username'};
+ }
+
+ # Lots of error-checking claptrap first...
+ unless ($self->server) {
+ unless ($ENV{IRCSERVER}) {
+ croak "No server address specified in connect()";
+ }
+ $self->server( $ENV{IRCSERVER} );
+ }
+ unless ($self->nick) {
+ $self->nick($ENV{IRCNICK} || eval { scalar getpwuid($>) }
+ || $ENV{USER} || $ENV{LOGNAME} || "WankerBot");
+ }
+ unless ($self->port) {
+ $self->port($ENV{IRCPORT} || 6667);
+ }
+ unless ($self->ircname) {
+ $self->ircname($ENV{IRCNAME} || eval { (getpwuid($>))[6] }
+ || "Just Another Perl Hacker");
+ }
+ unless ($self->username) {
+ $self->username(eval { scalar getpwuid($>) } || $ENV{USER}
+ || $ENV{LOGNAME} || "japh");
+ }
+
+ # Now for the socket stuff...
+ if ($self->connected) {
+ $self->quit("Changing servers");
+ }
+
+# my $sock = IO::Socket::INET->new(PeerAddr => $self->server,
+# PeerPort => $self->port,
+# Proto => "tcp",
+# );
+
+ $sock = Symbol::gensym();
+ unless (socket( $sock, PF_INET, SOCK_STREAM, getprotobyname('tcp') )) {
+ carp ("Can't create a new socket: $!");
+ $self->error(1);
+ return;
+ }
+
+ # This bind() stuff is so that people with virtual hosts can select
+ # the hostname they want to connect with. For this, I dumped the
+ # astonishingly gimpy IO::Socket. Talk about letting the interface
+ # get in the way of the functionality...
+
+ if ($hostname) {
+ unless (bind( $sock, sockaddr_in( 0, inet_aton($hostname) ) )) {
+ carp "Can't bind to $hostname: $!";
+ $self->error(1);
+ return;
+ }
+ }
+
+ if (connect( $sock, sockaddr_in($self->port, inet_aton($self->server)) )) {
+ $self->socket($sock);
+
+ } else {
+ carp (sprintf "Can't connect to %s:%s!",
+ $self->server, $self->port);
+ $self->error(1);
+ return;
+ }
+
+ # Send a PASS command if they specified a password. According to
+ # the RFC, we should do this as soon as we connect.
+ if (defined $password) {
+ $self->sl("PASS $password");
+ }
+
+ # Now, log in to the server...
+ unless ($self->sl('NICK ' . $self->nick()) and
+ $self->sl(sprintf("USER %s %s %s :%s",
+ $self->username(),
+ "foo.bar.com",
+ $self->server(),
+ $self->ircname()))) {
+ carp "Couldn't send introduction to server: $!";
+ $self->error(1);
+ $! = "Couldn't send NICK/USER introduction to " . $self->server;
+ return;
+ }
+
+ $self->{_connected} = 1;
+ $self->parent->addconn($self);
+}
+
+# Returns a boolean value based on the state of the object's socket.
+sub connected {
+ my $self = shift;
+
+ return ( $self->{_connected} and $self->socket() );
+}
+
+# Sends a CTCP request to some hapless victim(s).
+# Takes at least two args: the type of CTCP request (case insensitive)
+# the nick or channel of the intended recipient(s)
+# Any further args are arguments to CLIENTINFO, ERRMSG, or ACTION.
+sub ctcp {
+ my ($self, $type, $target) = splice @_, 0, 3;
+ $type = uc $type;
+
+ unless ($target) {
+ croak "Not enough arguments to ctcp()";
+ }
+
+ if ($type eq "PING") {
+ unless ($self->sl("PRIVMSG $target :\001PING " . time . "\001")) {
+ carp "Socket error sending $type request in ctcp()";
+ return;
+ }
+ } elsif (($type eq "CLIENTINFO" or $type eq "ACTION") and @_) {
+ unless ($self->sl("PRIVMSG $target :\001$type " .
+ CORE::join(" ", @_) . "\001")) {
+ carp "Socket error sending $type request in ctcp()";
+ return;
+ }
+ } elsif ($type eq "ERRMSG") {
+ unless (@_) {
+ carp "Not enough arguments to $type in ctcp()";
+ return;
+ }
+ unless ($self->sl("PRIVMSG $target :\001ERRMSG " .
+ CORE::join(" ", @_) . "\001")) {
+ carp "Socket error sending $type request in ctcp()";
+ return;
+ }
+ } else {
+ unless ($self->sl("PRIVMSG $target :\001$type " .
+ CORE::join(" ",@_) . "\001")) {
+ carp "Socket error sending $type request in ctcp()";
+ return;
+ }
+ }
+}
+
+# Sends replies to CTCP queries. Simple enough, right?
+# Takes 2 args: the target person or channel to send a reply to
+# the text of the reply
+sub ctcp_reply {
+ my $self = shift;
+
+ $self->notice($_[0], "\001" . $_[1] . "\001");
+}
+
+
+# Sets or returns the debugging flag for this object.
+# Takes 1 optional arg: a new boolean value for the flag.
+sub debug {
+ my $self = shift;
+ if (@_) {
+ $self->{_debug} = $_[0];
+ }
+ return $self->{_debug};
+}
+
+
+# Dequotes CTCP messages according to ctcp.spec. Nothing special.
+# Then it breaks them into their component parts in a flexible, ircII-
+# compatible manner. This is not quite as trivial. Oh, well.
+# Takes 1 arg: the line to be dequoted.
+sub dequote {
+ my $line = shift;
+ my ($order, @chunks) = (0, ()); # CHUNG! CHUNG! CHUNG!
+
+ # Filter misplaced \001s before processing... (Thanks, Tom!)
+ substr($line, rindex($line, "\001"), 1) = '\\a'
+ unless ($line =~ tr/\001//) % 2 == 0;
+
+ # Thanks to Abigail (abigail@fnx.com) for this clever bit.
+ if (index($line, "\cP") >= 0) { # dequote low-level \n, \r, ^P, and \0.
+ my (%h) = (n => "\012", r => "\015", 0 => "\0", "\cP" => "\cP");
+ $line =~ s/\cP([nr0\cP])/$h{$1}/g;
+ }
+ $line =~ s/\\([^\\a])/$1/g; # dequote unnecessarily quoted characters.
+
+ # -- #perl was here! --
+ # roy7: Chip Chip he's our man!
+ # fimmtiu: If he can't do it, Larry can!
+ # ChipDude: I thank you! No applause, just throw RAM chips!
+
+ # If true, it's in odd order... ctcp commands start with first chunk.
+ $order = 1 if index($line, "\001") == 0;
+ @chunks = map { s/\\\\/\\/g; $_ } (split /\cA/, $line);
+
+ return ($order, @chunks);
+}
+
+# Standard destructor method for the GC routines. (HAHAHAH! DIE! DIE! DIE!)
+sub DESTROY {
+ my $self = shift;
+ # how ironic.
+ $self->handler("destroy", "nobody will ever use this");
+}
+
+
+# Disconnects this Connection object cleanly from the server.
+# Takes at least 1 arg: the format and args parameters to Event->new().
+sub disconnect {
+ my $self = shift;
+
+ $self->{_connected} = 0;
+ $self->parent->removeconn($self);
+ $self->socket( undef );
+ $self->handler(Net::IRC::Event->new( "disconnect",
+ $self->server,
+ '',
+ @_ ));
+}
+
+
+# Tells IRC.pm if there was an error opening this connection. It's just
+# for sane error passing.
+# Takes 1 optional arg: the new value for $self->{'iserror'}
+sub error {
+ my $self = shift;
+
+ $self->{'iserror'} = $_[0] if @_;
+ return $self->{'iserror'};
+}
+
+# -- #perl was here! --
+# <nocarrier> No, I commute Mon-Wed-Fri from Allentown.
+# <rudefix> the billy joel and skinhead place
+# <nocarrier> that's what they say.
+# <\lembit> it's hard to keep a good man down.
+# <qw[jeff]> but only the good die young!
+# \lembit won't be getting up today.
+# <rudefix> because they're under too much pressure, jeff
+# <qw[jeff]> and it surely will catch up to them, somewhere along the line.
+
+
+# Lets the user set or retrieve a format for a message of any sort.
+# Takes at least 1 arg: the event whose format you're inquiring about
+# (optional) the new format to use for this event
+sub format {
+ my ($self, $ev) = splice @_, 0, 2;
+
+ unless ($ev) {
+ croak "Not enough arguments to format()";
+ }
+
+ if (@_) {
+ $self->{'_format'}->{$ev} = $_[0];
+ } else {
+ return ($self->{'_format'}->{$ev} ||
+ $self->{'_format'}->{'default'});
+ }
+}
+
+# -- #perl was here! --
+# <q[merlyn]> \lem... know any good austin Perl hackers for hire?
+# <q[merlyn]> I'm on a hunt for one for a friend.
+# <archon> for a job?
+# <Stupid_> No, in his spare time merlyn bow-hunts for perl programmers
+# by their scent.
+
+
+# Calls the appropriate handler function for a specified event.
+# Takes 2 args: the name of the event to handle
+# the arguments to the handler function
+sub handler {
+ my ($self, $event) = splice @_, 0, 2;
+
+ unless (defined $event) {
+ croak 'Too few arguments to Connection->handler()';
+ }
+
+ # Get name of event.
+ my $ev;
+ if (ref $event) {
+ $ev = $event->type;
+ } elsif (defined $event) {
+ $ev = $event;
+ $event = Net::IRC::Event->new($event, '', '', '');
+ } else {
+ croak "Not enough arguments to handler()";
+ }
+
+ print STDERR "Trying to handle event '$ev'.\n" if $self->{_debug};
+
+ # -- #perl was here! --
+ # <\lembit> tainted code...oh-oh..tainted code...sometimes I know I've
+ # got to (boink boink) run away...
+ # <Excession> \lembit I'd ease up on the caffiene if I were you
+
+ my $handler = undef;
+ if (exists $self->{_handler}->{$ev}) {
+ $handler = $self->{_handler}->{$ev};
+ } elsif (exists $_udef{$ev}) {
+ $handler = $_udef{$ev};
+ } else {
+ return $self->_default($event, @_);
+ }
+
+ my ($code, $rp) = @{$handler};
+
+ # If we have args left, try to call the handler.
+ if ($rp == 0) { # REPLACE
+ &$code($self, $event, @_);
+ } elsif ($rp == 1) { # BEFORE
+ &$code($self, $event, @_);
+ $self->_default($event, @_);
+ } elsif ($rp == 2) { # AFTER
+ $self->_default($event, @_);
+ &$code($self, $event, @_);
+ } else {
+ confess "Bad parameter passed to handler(): rp=$rp";
+ }
+
+ warn "Handler for '$ev' called.\n" if $self->{_debug};
+
+ return 1;
+}
+
+# -- #perl was here! --
+# <JavaJive> last night I dreamt I was flying over mountainous terrains
+# which changed into curves and and valleys shooting everywhere
+# and then finally into physical abominations which could never
+# really exist in the material universe.
+# <JavaJive> then I realized it was just one of my perl data structures.
+
+
+# Lets a user set hostmasks to discard certain messages from, or (if called
+# with only 1 arg), show a list of currently ignored hostmasks of that type.
+# Takes 2 args: type of ignore (public, msg, ctcp, etc)
+# (optional) [mask(s) to be added to list of specified type]
+sub ignore {
+ my $self = shift;
+
+ unless (@_) {
+ croak "Not enough arguments to ignore()";
+ }
+
+ if (@_ == 1) {
+ if (exists $self->{_ignore}->{$_[0]}) {
+ return @{ $self->{_ignore}->{$_[0]} };
+ } else {
+ return ();
+ }
+ } elsif (@_ > 1) { # code defensively, remember...
+ my $type = shift;
+
+ # I moved this part further down as an Obsessive Efficiency
+ # Initiative. It shouldn't be a problem if I do _parse right...
+ # ... but those are famous last words, eh?
+ unless (grep {$_ eq $type}
+ qw(public msg ctcp notice channel nick other all)) {
+ carp "$type isn't a valid type to ignore()";
+ return;
+ }
+
+ if ( exists $self->{_ignore}->{$type} ) {
+ push @{$self->{_ignore}->{$type}}, @_;
+ } else {
+ $self->{_ignore}->{$type} = [ @_ ];
+ }
+ }
+}
+
+
+# -- #perl was here! --
+# <Moonlord> someone can tell me some web side for "hack" programs
+# <fimmtiu> Moonlord: http://pinky.wtower.com/nethack/
+# <Moonlord> thank`s fimmtiu
+# fimmtiu giggles maniacally.
+
+
+# Yet Another Ridiculously Simple Sub. Sends an INFO command.
+# Takes 1 optional arg: the name of the server to query.
+sub info {
+ my $self = shift;
+
+ $self->sl("INFO" . ($_[0] ? " $_[0]" : ""));
+}
+
+
+# -- #perl was here! --
+# <Teratogen> terminals in the night
+# <Teratogen> exchanging ascii
+# <Teratogen> oops, we dropped a byte
+# <Teratogen> please hit the break key
+# <Teratogen> doo be doo be doo
+
+
+# Invites someone to an invite-only channel. Whoop.
+# Takes 2 args: the nick of the person to invite
+# the channel to invite them to.
+# I hate the syntax of this command... always seemed like a protocol flaw.
+sub invite {
+ my $self = shift;
+
+ unless (@_ > 1) {
+ croak "Not enough arguments to invite()";
+ }
+
+ $self->sl("INVITE $_[0] $_[1]");
+}
+
+# Checks if a particular nickname is in use.
+# Takes at least 1 arg: nickname(s) to look up.
+sub ison {
+ my $self = shift;
+
+ unless (@_) {
+ croak 'Not enough args to ison().';
+ }
+
+ $self->sl("ISON " . CORE::join(" ", @_));
+}
+
+# Joins a channel on the current server if connected, eh?.
+# Corresponds to /JOIN command.
+# Takes 2 args: name of channel to join
+# optional channel password, for +k channels
+sub join {
+ my $self = shift;
+
+ unless ( $self->connected ) {
+ carp "Can't join() -- not connected to a server";
+ return;
+ }
+
+ # -- #perl was here! --
+ # *** careful is Starch@ncb.mb.ca (The WebMaster)
+ # *** careful is on IRC via server irc.total.net (Montreal Hub &
+ # Client Server)
+ # careful: well, it's hard to buy more books now too cause where the
+ # heck do you put them all? i have to move and my puter room is
+ # almost 400 square feet, it's the largest allowed in my basement
+ # without calling it a room and pay taxes, hehe
+
+ unless (@_) {
+ croak "Not enough arguments to join()";
+ }
+
+ # \petey: paying taxes by the room?
+ # \petey boggles
+ # careful: that's what they do for finished basements and stuff
+ # careful: need an emergency exit and stuff
+ # jjohn: GOOD GOD! ARE THEY HEATHENS IN CANADA? DO THEY EAT THEIR
+ # OWN YOUNG?
+
+ return $self->sl("JOIN $_[0]" . ($_[1] ? " $_[1]" : ""));
+
+ # \petey: "On the 'net nobody knows you're Canadian, eh?"
+ # jjohn: shut up, eh?
+}
+
+# Opens a righteous can of whoop-ass on any luser foolish enough to ask a
+# CGI question in #perl. Eat flaming death, web wankers!
+# Takes at least 2 args: the channel to kick the bastard from
+# the nick of the bastard in question
+# (optional) a parting comment to the departing bastard
+sub kick {
+ my $self = shift;
+
+ unless (@_ > 1) {
+ croak "Not enough arguments to kick()";
+ }
+ return $self->sl("KICK $_[0] $_[1]" . ($_[2] ? " :$_[2]" : ""));
+}
+
+# -- #perl was here! --
+# sputnik1 listens in glee to the high-pitched whine of the Pratt
+# and Whitney generator heating up on the launcher of his
+# AGM-88B HARM missile
+# <lej> sputnik1: calm down, little commie satellite
+
+
+# Gets a list of all the servers that are linked to another visible server.
+# Takes 2 optional args: it's a bitch to describe, and I'm too tired right
+# now, so read the RFC.
+sub links {
+ my ($self) = (shift, undef);
+
+ $self->sl("LINKS" . (scalar(@_) ? " " . CORE::join(" ", @_[0,1]) : ""));
+}
+
+
+# Requests a list of channels on the server, or a quick snapshot of the current
+# channel (the server returns channel name, # of users, and topic for each).
+sub list {
+ my $self = shift;
+
+ $self->sl("LIST " . CORE::join(",", @_));
+}
+
+# -- #perl was here! --
+# <china`blu> see, neo?
+# <china`blu> they're crowded
+# <china`blu> i bet some programmers/coders might be here
+# <fimmtiu> Nope. No programmers here. We're just Larry Wall groupies.
+# <china`blu> come on
+# <Kilbaniar> Larry Wall isn't as good in bed as you'd think.
+# <Kilbaniar> For the record...
+
+
+# -- #perl was here! --
+# <Skrewtape> Larry Wall is a lot sexier than Richard Stallman
+# <Skrewtape> But I've heard Stallman is better in bed.
+# <Schwern> Does he leave the halo on?
+# * aether cocks her head at skrew...uh...whatever?
+# <fimmtiu> Stallman's beard is a sex magnet.
+# <Skrewtape> Larry's moustache is moreso, Fimm.
+# <aether> oh yeah...women all over the world are hot for stallman....
+# <Skrewtape> Moustaches make my heart melt.
+# <Schwern> I dunno, there's something about a man in hawaiian shirts...
+
+
+# Sends a request for some server/user stats.
+# Takes 1 optional arg: the name of a server to request the info from.
+sub lusers {
+ my $self = shift;
+
+ $self->sl("LUSERS" . ($_[0] ? " $_[0]" : ""));
+}
+
+# Gets and/or sets the max line length. The value previous to the sub
+# call will be returned.
+# Takes 1 (optional) arg: the maximum line length (in bytes)
+sub maxlinelen {
+ my $self = shift;
+
+ my $ret = $self->{_maxlinelen};
+
+ $self->{_maxlinelen} = shift if @_;
+
+ return $ret;
+}
+
+# -- #perl was here! --
+# <KeithW> Hey, actually, I just got a good idea for an April Fools-day
+# emacs mode.
+# <KeithW> tchrist-mode
+# <amagosa> Heh heh
+# <KeithW> When you finish typing a word, emacs automatically replaces it
+# with the longest synonym from the online Merriam-Webster
+# thesaurus.
+
+
+# Sends an action to the channel/nick you specify. It's truly amazing how
+# many IRCers have no idea that /me's are actually sent via CTCP.
+# Takes 2 args: the channel or nick to bother with your witticism
+# the action to send (e.g., "weed-whacks billn's hand off.")
+sub me {
+ my $self = shift;
+
+ $self->ctcp("ACTION", $_[0], $_[1]);
+}
+
+# -- #perl was here! --
+# *** china`blu (azizam@pm5-30.flinet.com) has joined channel #perl
+# <china`blu> hi guys
+# <china`blu> and girls
+# <purl> I am NOT a lesbian!
+
+
+# Change channel and user modes (this one is easy... the handler is a bitch.)
+# Takes at least 1 arg: the target of the command (channel or nick)
+# (optional) the mode string (i.e., "-boo+i")
+# (optional) operands of the mode string (nicks, hostmasks, etc.)
+sub mode {
+ my $self = shift;
+
+ unless (@_ >= 1) {
+ croak "Not enough arguments to mode()";
+ }
+ $self->sl("MODE $_[0] " . CORE::join(" ", @_[1..$#_]));
+}
+
+# -- #perl was here! --
+# *** billnolio (billn@initiate.monk.org) has joined channel #perl
+# *** Mode change "+v billnolio" on channel #perl by select
+# billnolio humps fimmtiu's leg
+# *** billnolio has left channel #perl
+
+
+# Sends a MOTD command to a server.
+# Takes 1 optional arg: the server to query (defaults to current server)
+sub motd {
+ my $self = shift;
+
+ $self->sl("MOTD" . ($_[0] ? " $_[0]" : ""));
+}
+
+# -- #perl was here! --
+# <Roderick> "Women were put on this earth to weaken us. Drain our energy.
+# Laugh at us when they see us naked."
+# <qw[jeff]> rod - maybe YOUR women...
+# <fimmtiu> jeff: Oh, just wait....
+# <Roderick> "Love is a snowmobile racing across the tundra, which
+# suddenly flips over, pinning you underneath. At night,
+# the ice weasels come."
+# <qw[jeff]> rod - where do you GET these things?!
+# <Roderick> They do tend to accumulate. Clutter in the brain.
+
+
+# Requests the list of users for a particular channel (or the entire net, if
+# you're a masochist).
+# Takes 1 or more optional args: name(s) of channel(s) to list the users from.
+sub names {
+ my $self = shift;
+
+ $self->sl("NAMES " . CORE::join(",", @_));
+
+} # Was this the easiest sub in the world, or what?
+
+# Creates a new IRC object and assigns some default attributes.
+sub new {
+ my $proto = shift;
+
+ # -- #perl was here! --
+ # <\merlyn> just don't use ref($this) || $this;
+ # <\merlyn> tchrist's abomination.
+ # <\merlyn> lame lame lame. frowned upon by any OO programmer I've seen.
+ # <tchrist> randal disagrees, but i don't care.
+ # <tchrist> Randal isn't being flexible/imaginative.
+ # <ChipDude> fimm: WRT "ref ($proto) || $proto", I'm against. Class
+ # methods and object methods are distinct.
+
+ # my $class = ref($proto) || $proto; # Man, am I confused...
+
+ my $self = { # obvious defaults go here, rest are user-set
+ _debug => $_[0]->{_debug},
+ _port => 6667,
+ # Evals are for non-UNIX machines, just to make sure.
+ _username => eval { scalar getpwuid($>) } || $ENV{USER}
+ || $ENV{LOGNAME} || "japh",
+ _ircname => $ENV{IRCNAME} || eval { (getpwuid($>))[6] }
+ || "Just Another Perl Hacker",
+ _nick => $ENV{IRCNICK} || eval { scalar getpwuid($>) }
+ || $ENV{USER} || $ENV{LOGNAME} || "WankerBot", # heheh...
+ _ignore => {},
+ _handler => {},
+ _verbose => 0, # Is this an OK default?
+ _parent => shift,
+ _frag => '',
+ _connected => 0,
+ _maxlinelen => 510, # The RFC says we shouldn't exceed this.
+ _format => {
+ 'default' => "[%f:%t] %m <%d>",
+ },
+ };
+
+ bless $self, $proto;
+ # do any necessary initialization here
+ $self->connect(@_) if @_;
+
+ return $self;
+}
+
+# Creates and returns a DCC CHAT object, analogous to IRC.pm's newconn().
+# Takes at least 1 arg: An Event object for the DCC CHAT request.
+# OR A list or listref of args to be passed to new(),
+# consisting of:
+# - A boolean value indicating whether or not
+# you're initiating the CHAT connection.
+# - The nick of the chattee
+# - The address to connect to
+# - The port to connect on
+sub new_chat {
+ my $self = shift;
+ my ($init, $nick, $address, $port);
+
+ if (ref($_[0]) =~ /Event/) {
+ # If it's from an Event object, we can't be initiating, right?
+ ($init, undef, undef, undef, $address, $port) = (0, $_[0]->args);
+ $nick = $_[0]->nick;
+
+ } elsif (ref($_[0]) eq "ARRAY") {
+ ($init, $nick, $address, $port) = @{$_[0]};
+ } else {
+ ($init, $nick, $address, $port) = @_;
+ }
+
+ # -- #perl was here! --
+ # gnat snorts.
+ # gnat: no fucking microsoft products, thanks :)
+ # ^Pudge: what about non-fucking MS products? i hear MS Bob is a virgin.
+
+ Net::IRC::DCC::CHAT->new($self, $init, $nick, $address, $port);
+}
+
+# Creates and returns a DCC GET object, analogous to IRC.pm's newconn().
+# Takes at least 1 arg: An Event object for the DCC SEND request.
+# OR A list or listref of args to be passed to new(),
+# consisting of:
+# - The nick of the file's sender
+# - The name of the file to receive
+# - The address to connect to
+# - The port to connect on
+# - The size of the incoming file
+# For all of the above, an extra argument can be added at the end:
+# An open filehandle to save the incoming file into,
+# in globref, FileHandle, or IO::* form.
+sub new_get {
+ my $self = shift;
+ my ($nick, $name, $address, $port, $size, $handle);
+
+ if (ref($_[0]) =~ /Event/) {
+ (undef, undef, $name, $address, $port, $size) = $_[0]->args;
+ $nick = $_[0]->nick;
+ $handle = $_[1] if defined $_[1];
+ } elsif (ref($_[0]) eq "ARRAY") {
+ ($nick, $name, $address, $port, $size) = @{$_[0]};
+ $handle = $_[1] if defined $_[1];
+ } else {
+ ($nick, $name, $address, $port, $size, $handle) = @_;
+ }
+
+ unless (defined $handle and ref $handle and
+ (ref $handle eq "GLOB" or $handle->can('print')))
+ {
+ carp ("Filehandle argument to Connection->new_get() must be ".
+ "a glob reference or object");
+ return; # is this behavior OK?
+ }
+
+ my $dcc = Net::IRC::DCC::GET->new($self, $nick, $address,
+ $port, $size, $name, $handle);
+
+ $self->parent->addconn($dcc) if $dcc;
+ return $dcc;
+}
+
+# Creates and returns a DCC SEND object, analogous to IRC.pm's newconn().
+# Takes at least 2 args: The nickname of the person to send to
+# The name of the file to send
+# (optional) The blocksize for the connection (default 1k)
+sub new_send {
+ my $self = shift;
+ my ($nick, $filename, $blocksize);
+
+ if (ref($_[0]) eq "ARRAY") {
+ ($nick, $filename, $blocksize) = @{$_[0]};
+ } else {
+ ($nick, $filename, $blocksize) = @_;
+ }
+
+ Net::IRC::DCC::SEND->new($self, $nick, $filename, $blocksize);
+}
+
+# -- #perl was here! --
+# [petey suspects I-Que of not being 1337!
+# <fimmtiu> Eat flaming death, petey.
+# <I-Que> I'm only 22!
+# <I-Que> not 1337
+
+
+# Selects nick for this object or returns currently set nick.
+# No default; must be set by user.
+# If changed while the object is already connected to a server, it will
+# automatically try to change nicks.
+# Takes 1 arg: the nick. (I bet you could have figured that out...)
+sub nick {
+ my $self = shift;
+
+ if (@_) {
+ $self->{'_nick'} = shift;
+ if ($self->connected) {
+ return $self->sl("NICK " . $self->{'_nick'});
+ }
+ } else {
+ return $self->{'_nick'};
+ }
+}
+
+# Sends a notice to a channel or person.
+# Takes 2 args: the target of the message (channel or nick)
+# the text of the message to send
+# The message will be chunked if it is longer than the _maxlinelen
+# attribute, but it doesn't try to protect against flooding. If you
+# give it too much info, the IRC server will kick you off!
+sub notice {
+ my ($self, $to) = splice @_, 0, 2;
+
+ unless (@_) {
+ croak "Not enough arguments to notice()";
+ }
+
+ my ($buf, $length, $line) = (CORE::join("", @_), $self->{_maxlinelen});
+
+ while($buf) {
+ ($line, $buf) = unpack("a$length a*", $buf);
+ $self->sl("NOTICE $to :$line");
+ }
+}
+
+# -- #perl was here! --
+# <TorgoX> this was back when I watched Talk Soup, before I had to stop
+# because I saw friends of mine on it.
+# [petey chuckles at TorgoX
+# <Technik> TorgoX: on the Jerry Springer clips?
+# <TorgoX> I mean, when people you know appear on, like, some Springer
+# knockoff, in a cheap disguise, and the Talk Soup host makes fun
+# of them, you just have to stop.
+# <Technik> TorgoX: you need to get better friends
+# <TorgoX> I was shamed. I left town.
+# <TorgoX> grad school was just the pretext for the move. this was the
+# real reason.
+# <Technik> lol
+
+
+# Makes you an IRCop, if you supply the right username and password.
+# Takes 2 args: Operator's username
+# Operator's password
+sub oper {
+ my $self = shift;
+
+ unless (@_ > 1) {
+ croak "Not enough arguments to oper()";
+ }
+
+ $self->sl("OPER $_[0] $_[1]");
+}
+
+# This function splits apart a raw server line into its component parts
+# (message, target, message type, CTCP data, etc...) and passes it to the
+# appropriate handler. Takes no args, really.
+sub parse {
+ my ($self) = shift;
+ my ($from, $type, $message, @stuff, $itype, $ev, @lines, $line);
+
+ # Read newly arriving data from $self->socket
+ # -- #perl was here! --
+ # <Tkil2> hm.... any joy if you add a 'defined' to the test? like
+ # if (defined $sock...
+ # <fimmtiu> Much joy now.
+ # archon rejoices
+
+ if (defined recv($self->socket, $line, 10240, 0) and
+ (length($self->{_frag}) + length($line)) > 0) {
+ # grab any remnant from the last go and split into lines
+ my $chunk = $self->{_frag} . $line;
+ @lines = split /\012/, $chunk;
+
+ # if the last line was incomplete, pop it off the chunk and
+ # stick it back into the frag holder.
+ $self->{_frag} = (substr($chunk, -1) ne "\012" ? pop @lines : '');
+
+ } else {
+ # um, if we can read, i say we should read more than 0
+ # besides, recv isn't returning undef on closed
+ # sockets. getting rid of this connection...
+ $self->disconnect('error', 'Connection reset by peer');
+ return;
+ }
+
+ foreach $line (@lines) {
+
+ # Clean the lint filter every 2 weeks...
+ $line =~ s/[\012\015]+$//;
+ next unless $line;
+
+ print STDERR "<<< $line\n" if $self->{_debug};
+
+ # Like the RFC says: "respond as quickly as possible..."
+ if ($line =~ /^PING/) {
+ $ev = (Net::IRC::Event->new( "ping",
+ $self->server,
+ $self->nick,
+ "serverping", # FIXME?
+ substr($line, 5)
+ ));
+
+ # Had to move this up front to avoid a particularly pernicious bug.
+ } elsif ($line =~ /^NOTICE/) {
+ $ev = Net::IRC::Event->new( "snotice",
+ $self->server,
+ '',
+ 'server',
+ (split /:/, $line, 2)[1] );
+
+
+ # Spurious backslashes are for the benefit of cperl-mode.
+ # Assumption: all non-numeric message types begin with a letter
+ } elsif ($line =~ /^:?
+ ([][}{\w\\\`^|\-]+? # The nick (valid nickname chars)
+ ! # The nick-username separator
+ .+? # The username
+ \@)? # Umm, duh...
+ \S+ # The hostname
+ \s+ # Space between mask and message type
+ [A-Za-z] # First char of message type
+ [^\s:]+? # The rest of the message type
+ /x) # That ought to do it for now...
+ {
+ $line = substr $line, 1 if $line =~ /^:/;
+ ($from, $line) = split ":", $line, 2;
+ ($from, $type, @stuff) = split /\s+/, $from;
+ $type = lc $type;
+
+ # This should be fairly intuitive... (cperl-mode sucks, though)
+ if (defined $line and index($line, "\001") >= 0) {
+ $itype = "ctcp";
+ unless ($type eq "notice") {
+ $type = (($stuff[0] =~ tr/\#\&//) ? "public" : "msg");
+ }
+ } elsif ($type eq "privmsg") {
+ $itype = $type = (($stuff[0] =~ tr/\#\&//) ? "public" : "msg");
+ } elsif ($type eq "notice") {
+ $itype = "notice";
+ } elsif ($type eq "join" or $type eq "part" or
+ $type eq "mode" or $type eq "topic" or
+ $type eq "kick") {
+ $itype = "channel";
+ } elsif ($type eq "nick") {
+ $itype = "nick";
+ } else {
+ $itype = "other";
+ }
+
+ # This goes through the list of ignored addresses for this message
+ # type and drops out of the sub if it's from an ignored hostmask.
+
+ study $from;
+ foreach ( $self->ignore($itype), $self->ignore("all") ) {
+ $_ = quotemeta; s/\\\*/.*/g;
+ return 1 if $from =~ /$_/;
+ }
+
+ # It used to look a lot worse. Here was the original version...
+ # the optimization above was proposed by Silmaril, for which I am
+ # eternally grateful. (Mine still looks cooler, though. :)
+
+ # return if grep { $_ = join('.*', split(/\\\*/,
+ # quotemeta($_))); /$from/ }
+ # ($self->ignore($type), $self->ignore("all"));
+
+ # Add $line to @stuff for the handlers
+ push @stuff, $line if defined $line;
+
+ # Now ship it off to the appropriate handler and forget about it.
+ if ( $itype eq "ctcp" ) { # it's got CTCP in it!
+ $self->parse_ctcp($type, $from, $stuff[0], $line);
+ return 1;
+
+ } elsif ($type eq "public" or $type eq "msg" or
+ $type eq "notice" or $type eq "mode" or
+ $type eq "join" or $type eq "part" or
+ $type eq "topic" or $type eq "invite" ) {
+
+ $ev = Net::IRC::Event->new( $type,
+ $from,
+ shift(@stuff),
+ $type,
+ @stuff,
+ );
+ } elsif ($type eq "quit" or $type eq "nick") {
+
+ $ev = Net::IRC::Event->new( $type,
+ $from,
+ $from,
+ $type,
+ @stuff,
+ );
+ } elsif ($type eq "kick") {
+
+ $ev = Net::IRC::Event->new( $type,
+ $from,
+ $stuff[1],
+ $type,
+ @stuff[0,2..$#stuff],
+ );
+
+ } elsif ($type eq "kill") {
+ $ev = Net::IRC::Event->new($type,
+ $from,
+ '',
+ $type,
+ $line); # Ahh, what the hell.
+ } elsif ($type eq "wallops") {
+ $ev = Net::IRC::Event->new($type,
+ $from,
+ '',
+ $type,
+ $line);
+ } else {
+ carp "Unknown event type: $type";
+ }
+ }
+
+ # -- #perl was here! --
+ # *** orwant (orwant@media.mit.edu) has joined channel #perl
+ # orwant: Howdy howdy.
+ # orwant: Just came back from my cartooning class.
+ # orwant: I'm working on a strip for TPJ.
+ # njt: it's happy bouncy clown jon from clownland! say 'hi' to
+ # the kiddies, jon!
+ # orwant splits open njt like a wet bag of groceries and
+ # dances on his sticky bones.
+ # njt: excuse me, ladies, but I've got to go eviscerate myself with
+ # a leaky biro. don't wait up.
+
+ elsif ($line =~ /^:? # Here's Ye Olde Numeric Handler!
+ \S+? # the servername (can't assume RFC hostname)
+ \s+? # Some spaces here...
+ \d+? # The actual number
+ \b/x # Some other crap, whatever...
+ ) {
+ $ev = $self->parse_num($line);
+
+ } elsif ($line =~ /^:(\w+) MODE \1 /) {
+ $ev = Net::IRC::Event->new( 'umode',
+ $self->server,
+ $self->nick,
+ 'server',
+ substr($line, index($line, ':', 1) + 1));
+
+ } elsif ($line =~ /^:? # Here's Ye Olde Server Notice handler!
+ .+? # the servername (can't assume RFC hostname)
+ \s+? # Some spaces here...
+ NOTICE # The server notice
+ \b/x # Some other crap, whatever...
+ ) {
+ $ev = Net::IRC::Event->new( 'snotice',
+ $self->server,
+ '',
+ 'server',
+ (split /\s+/, $line, 3)[2] );
+
+
+ } elsif ($line =~ /^ERROR/) {
+ if ($line =~ /^ERROR :Closing [Ll]ink/) { # is this compatible?
+
+ $ev = 'done';
+ $self->disconnect( 'error', ($line =~ /(.*)/) );
+
+ } else {
+ $ev = Net::IRC::Event->new( "error",
+ $self->server,
+ '',
+ 'error',
+ (split /:/, $line, 2)[1]);
+ }
+ } elsif ($line =~ /^Closing [Ll]ink/) {
+ $ev = 'done';
+ $self->disconnect( 'error', ($line =~ /(.*)/) );
+
+ }
+
+ if ($ev) {
+
+ # We need to be able to fall through if the handler has
+ # already been called (i.e., from within disconnect()).
+
+ $self->handler($ev) unless $ev eq 'done';
+
+ } else {
+ # If it gets down to here, it's some exception I forgot about.
+ carp "Funky parse case: $line\n";
+ }
+ }
+}
+
+# The backend that parse() sends CTCP requests off to. Pay no attention
+# to the camel behind the curtain.
+# Takes 4 arguments: the type of message
+# who it's from
+# the first bit of stuff
+# 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') {
+ $prefix = 'cr';
+ } elsif ($type eq 'public' or
+ $type eq 'msg' ) {
+ $prefix = 'c';
+ } else {
+ carp "Unknown CTCP type: $type";
+ return;
+ }
+
+ if ($prefix) {
+ my $handler = $prefix . lc $ctype; # unit. value prob with $ctype
+
+ # -- #perl was here! --
+ # fimmtiu: Words cannot describe my joy. Sil, you kick ass.
+ # fimmtiu: I was passing the wrong arg to Event::new()
+
+ $self->handler(Net::IRC::Event->new($handler, $from, $stuff,
+ $handler, (split /\s/, $one)));
+ }
+
+ # This next line is very likely broken somehow. Sigh.
+ $self->handler(Net::IRC::Event->new($type, $from, $stuff, $type, $two))
+ if ($two);
+ }
+ return 1;
+}
+
+# Does special-case parsing for numeric events. Separate from the rest of
+# parse() for clarity reasons (I can hear Tkil gasping in shock now. :-).
+# Takes 1 arg: the raw server line
+sub parse_num {
+ my ($self, $line) = @_;
+
+ ## Figlet protection? This seems to be a bit closer to the RFC than
+ ## the original version, which doesn't seem to handle :trailers quite
+ ## correctly.
+
+ my ($from, $type, $stuff) = split(/\s+/, $line, 3);
+ my ($blip, $space, $other, @stuff);
+ while ($stuff) {
+ ($blip, $space, $other) = split(/(\s+)/, $stuff, 2);
+ $space = "" unless $space;
+ $other = "" unless $other; # I hate warnings. Thanks to jack velte...
+ if ($blip =~ /^:/) {
+ push @stuff, $blip . $space . $other;
+ last;
+ } else {
+ push @stuff, $blip;
+ $stuff = $other;
+ }
+ }
+
+ $from = substr $from, 1 if $from =~ /^:/;
+
+ return Net::IRC::Event->new( $type,
+ $from,
+ '',
+ 'server',
+ @stuff );
+}
+
+# -- #perl was here! --
+# <megas> heh, why are #windowsNT people so quiet? are they all blue screened?
+# <Hiro> they're busy flapping their arms and making swooshing jet noises
+
+
+# Helps you flee those hard-to-stand channels.
+# Takes at least one arg: name(s) of channel(s) to leave.
+sub part {
+ my $self = shift;
+
+ unless (@_) {
+ croak "No arguments provided to part()";
+ }
+ $self->sl("PART " . CORE::join(",", @_)); # "A must!"
+}
+
+
+# Tells what's on the other end of a connection. Returns a 2-element list
+# consisting of the name on the other end and the type of connection.
+# Takes no args.
+sub peer {
+ my $self = shift;
+
+ return ($self->server(), "IRC connection");
+}
+
+
+# -- #perl was here! --
+# <thoth> We will have peace, when you and all your works have perished--
+# and the works of your Dark Master, Mammon, to whom you would
+# deliver us. You are a strumpet, Fmh, and a corrupter of men's
+# hearts.
+# <Fmh> thoth, smile when you say that
+# <Fmh> i'd much rather be thought of as a corrupter of women's hearts.
+
+
+# Prints a message to the defined error filehandle(s).
+# No further description should be necessary.
+sub printerr {
+ shift;
+ print STDERR @_, "\n";
+}
+
+
+# -- #perl was here! --
+# <_thoth> The hummer was like six feet up.
+# <_thoth> Humming.
+# <_thoth> The cat did this Flash trick.
+# <_thoth> And when the cat landed, there was a hummer in his mouth.
+# <_thoth> Once you see a cat pluck a hummer from the sky, you know why
+# the dogs are scared.
+
+
+# Prints a message to the defined output filehandle(s).
+sub print {
+ shift;
+ print STDOUT @_, "\n";
+}
+
+# Sends a message to a channel or person.
+# Takes 2 args: the target of the message (channel or nick)
+# the text of the message to send
+# Don't use this for sending CTCPs... that's what the ctcp() function is for.
+# The message will be chunked if it is longer than the _maxlinelen
+# attribute, but it doesn't try to protect against flooding. If you
+# give it too much info, the IRC server will kick you off!
+sub privmsg {
+ my ($self, $to) = splice @_, 0, 2;
+
+ unless (@_) {
+ croak 'Not enough arguments to privmsg()';
+ }
+
+ my $buf = CORE::join '', @_;
+ my $length = $self->{_maxlinelen} - 11 - length($to);
+ my $line;
+
+ # -- #perl was here! --
+ # <v0id_> i really haven't dug into Net::IRC yet.
+ # <v0id_> hell, i still need to figure out how to make it just say
+ # something on its current channel...
+ # <fimmtiu> $connection->privmsg('#channel', "Umm, hi.");
+ # <v0id_> but you have to know the channel already eh?
+ # <fimmtiu> Yes. This is how IRC works. :-)
+ # <v0id_> damnit, why can't everything be a default. :)
+ # <happybob> v0id_: it can. you end up with things like a 1 button
+ # mouse then, though. :)
+
+ if (ref($to) =~ /^(GLOB|IO::Socket)/) {
+ while($buf) {
+ ($line, $buf) = unpack("a$length a*", $buf);
+ send($to, $line . "\012", 0);
+ }
+ } else {
+ while($buf) {
+ ($line, $buf) = unpack("a$length a*", $buf);
+ if (ref $to eq 'ARRAY') {
+ $self->sl("PRIVMSG ", CORE::join(',', @$to), " :$line");
+ } else {
+ $self->sl("PRIVMSG $to :$line");
+ }
+ }
+ }
+}
+
+
+# Closes connection to IRC server. (Corresponding function for /QUIT)
+# Takes 1 optional arg: parting message, defaults to "Leaving" by custom.
+sub quit {
+ my $self = shift;
+
+ # Do any user-defined stuff before leaving
+ $self->handler("leaving");
+
+ unless ( $self->connected ) { return (1) }
+
+ # Why bother checking for sl() errors now, after all? :)
+ # We just send the QUIT command and leave. The server will respond with
+ # a "Closing link" message, and parse() will catch it, close the
+ # connection, and throw a "disconnect" event. Neat, huh? :-)
+
+ $self->sl("QUIT :" . (defined $_[0] ? $_[0] : "Leaving"));
+ return 1;
+}
+
+# As per the RFC, ask the server to "re-read and process its configuration
+# file." Your server may or may not take additional arguments. Generally
+# requires IRCop status.
+sub rehash {
+ my $self = shift;
+ $self->sl("REHASH" . CORE::join(" ", @_));
+}
+
+
+# As per the RFC, "force a server restart itself." (Love that RFC.)
+# Takes no arguments. If it succeeds, you will likely be disconnected,
+# but I assume you already knew that. This sub is too simple...
+sub restart {
+ my $self = shift;
+ $self->sl("RESTART");
+}
+
+# Schedules an event to be executed after some length of time.
+# Takes at least 2 args: the number of seconds to wait until it's executed
+# a coderef to execute when time's up
+# Any extra args are passed as arguments to the user's coderef.
+sub schedule {
+ my ($self, $time, $code) = splice @_, 0, 3;
+
+ unless ($code) {
+ croak 'Not enough arguments to Connection->schedule()';
+ }
+ unless (ref $code eq 'CODE') {
+ croak 'Second argument to schedule() isn\'t a coderef';
+ }
+
+ $time = time + int $time;
+ $self->parent->queue($time, $code, $self, @_);
+}
+
+
+# -- #perl was here! --
+# <freeside> YOU V3GAN FIEND, J00 W1LL P4Y D3ARLY F0R TH1S TRESPASS!!!!!!!!!!!
+# <Netslave> be quiet freeside
+# <freeside> WE W1LL F0RCE PR0K DOWN YOUR V1RG1N THR0AT
+# <freeside> MAKE ME
+# <freeside> :-PPPPPPPPP
+# <freeside> FORCE IS THE LAST REFUGE OF THE WEAK
+# <freeside> I DIE, OH, HORATIO, I DIE!
+# Che_Fox hugs freeside
+# <initium> freeside (=
+# <Che_Fox> I lurve you all :)
+# freeside lashes himself to the M4ST.
+# <Netslave> freeside, why do you eat meat?
+# <freeside> 4NARCHY R00000LZ!!!!! F1GHT TH3 P0W3R!!!!!!
+# <freeside> I 3AT M3AT S0 TH4T J00 D0N'T H4V3 TO!!!!!!!!!!!!
+# <freeside> I 3AT M3AT F0R J00000R SINS, NETSLAVE!!!!!!!!!!
+# <freeside> W0RSH1P M3333333!!!!!!!
+# *** t0fu (wasian@pm3l-12.pacificnet.net) joined #perl.
+# Che_Fox giggles
+# *** t0fu (wasian@pm3l-12.pacificnet.net) left #perl.
+# <freeside> T0FU, MY SAV10UIRRRRRRRRRRRRR
+# <freeside> NOOOOOOOOOOOOOO
+# <freeside> COME BAAAAAAAAAACK
+# <Che_Fox> no t0fu for you.
+
+
+# Lets J. Random IRCop connect one IRC server to another. How uninteresting.
+# Takes at least 1 arg: the name of the server to connect your server with
+# (optional) the port to connect them on (default 6667)
+# (optional) the server to connect to arg #1. Used mainly by
+# servers to communicate with each other.
+sub sconnect {
+ my $self = shift;
+
+ unless (@_) {
+ croak "Not enough arguments to sconnect()";
+ }
+ $self->sl("CONNECT " . CORE::join(" ", @_));
+}
+
+# Sets/changes the IRC server which this instance should connect to.
+# Takes 1 arg: the name of the server (see below for possible syntaxes)
+# ((syntaxen? syntaxi? syntaces?))
+sub server {
+ my ($self) = shift;
+
+ if (@_) {
+ # cases like "irc.server.com:6668"
+ if (index($_[0], ':') > 0) {
+ my ($serv, $port) = split /:/, $_[0];
+ if ($port =~ /\D/) {
+ carp "$port is not a valid port number in server()";
+ return;
+ }
+ $self->{_server} = $serv;
+ $self->port($port);
+
+ # cases like ":6668" (buried treasure!)
+ } elsif (index($_[0], ':') == 0 and $_[0] =~ /^:(\d+)/) {
+ $self->port($1);
+
+ # cases like "irc.server.com"
+ } else {
+ $self->{_server} = shift;
+ }
+ return (1);
+
+ } else {
+ return $self->{_server};
+ }
+}
+
+
+# Sends a raw IRC line to the server.
+# Corresponds to the internal sirc function of the same name.
+# Takes 1 arg: string to send to server. (duh. :)
+sub sl {
+ my $self = shift;
+ my $line = CORE::join '', @_;
+
+ unless (@_) {
+ croak "Not enough arguments to sl()";
+ }
+
+ ### DEBUG DEBUG DEBUG
+ if ($self->{_debug}) {
+ print ">>> $line\n";
+ }
+
+ # RFC compliance can be kinda nice...
+ my $rv = send( $self->{_socket}, "$line\015\012", 0 );
+ unless ($rv) {
+ $self->handler("sockerror");
+ return;
+ }
+ return $rv;
+}
+
+# -- #perl was here! --
+# <mandrake> the person at wendy's in front of me had a heart attack while
+# I was at lunch
+# <Stupid> mandrake: Before or -after- they ate the food?
+# <DrForr> mandrake: What did he have?
+# <mandrake> DrForr: a big bacon classic
+
+# Tells any server that you're an oper on to disconnect from the IRC network.
+# Takes at least 1 arg: the name of the server to disconnect
+# (optional) a comment about why it was disconnected
+sub squit {
+ my $self = shift;
+
+ unless (@_) {
+ croak "Not enough arguments to squit()";
+ }
+
+ $self->sl("SQUIT $_[0]" . ($_[1] ? " :$_[1]" : ""));
+}
+
+# -- #perl was here! --
+# * QDeath is trying to compile a list of email addresses given a HUGE
+# file of people's names... :)
+# <fimmtiu> Is this spam-related?
+# <QDeath> no, actually, it's official school related.
+# <fimmtiu> Good. Was afraid I had been doing the devil's work for a second.
+# * Tkil sprinkles fimmtiu's terminal with holy water, just in case.
+# *** Signoff: billn (Fimmtiu is the devil's tool. /msg him and ask him
+# about it.)
+# *Fmh* are you the devil's "tool" ?
+# -> *fmh* Yep. All 6 feet of me.
+
+
+# Gets various server statistics for the specified host.
+# Takes at least 1 arg: the type of stats to request [chiklmouy]
+# (optional) the server to request from (default is current server)
+sub stats {
+ my $self = shift;
+
+ unless (@_) {
+ croak "Not enough arguments passed to stats()";
+ }
+
+ $self->sl("STATS $_[0]" . ($_[1] ? " $_[1]" : ""));
+}
+
+# -- #perl was here! --
+# <Schwern> Wheat grass juice is properly served in a NyQuil sized cup, in
+# a NyQuil sized color with a NyQuil sized flavor.
+# <mendel> how big is nyquil's color
+# <foobah> often wheat grass is served mixed in with other fruit juices
+# <Sauvin> nyquil++
+# <Schwern> mendel: As BIG AS THE FUCKIN' Q!
+# <yuckf00> this big <---------------------------------->
+# <foobah> since by itself it can burn holes in your esophagus
+
+
+
+
+# If anyone still has SUMMON enabled, this will implement it for you.
+# If not, well...heh. Sorry. First arg mandatory: user to summon.
+# Second arg optional: a server name.
+sub summon {
+ my $self = shift;
+
+ unless (@_) {
+ croak "Not enough arguments passed to summon()";
+ }
+
+ $self->sl("SUMMON $_[0]" . ($_[1] ? " $_[1]" : ""));
+}
+
+
+# -- #perl was here! --
+# <Sauvin> Bigotry will never die.
+# <billn> yes it will
+# <billn> as soon as I'm allowed to buy weapons.
+# <Schwern> billn++
+# <rmah> billn, baisc human nature has to change for bigotry to go away
+# <billn> rmah: no, I just need bigger guns.
+
+
+# Requests timestamp from specified server. Easy enough, right?
+# Takes 1 optional arg: a server name/mask to query
+sub time {
+ my ($self, $serv) = (shift, undef);
+
+ $self->sl("TIME" . ($_[0] ? " $_[0]" : ""));
+}
+
+# -- #perl was here! --
+# <Murr> DrForr, presumably the tank crew *knew* how to swim, but not how
+# to escape from a tank with open hatch that had turned on its roof
+# before sinking.
+# <DrForr> The tank flipped over -then- sank? Now that's rich.
+# <arkuat> what is this about? cisco is building tanks now?
+# <Winkola> arkuat: If they do, you can count on a lot of drowned newbie
+# net admins.
+# <Winkola> "To report a drowning emergency, press 1, and hold for 27 minutes."
+
+
+# Sends request for current topic, or changes it to something else lame.
+# Takes at least 1 arg: the channel whose topic you want to screw around with
+# (optional) the new topic you want to impress everyone with
+sub topic {
+ my $self = shift;
+
+ unless (@_) {
+ croak "Not enough arguments to topic()";
+ }
+
+ # Can you tell I've been reading the Nethack source too much? :)
+ $self->sl("TOPIC $_[0]" . ($_[1] ? " :$_[1]" : ""));
+}
+
+# -- #perl was here! --
+# crimethnk: problem found.
+# crimethnk: log file was 2GB and i could not write to it anymore.
+# crimethnk: shit. lost almost a week of stats.
+# vorsprung: crimethnk> i guess you'll have to rotate the logs more frequently
+# crimethnk: i usually rotate once a month. i missed last month.
+# crimethnk: i thought i was pregnant.
+
+
+# Sends a trace request to the server. Whoop.
+# Take 1 optional arg: the server or nickname to trace.
+sub trace {
+ my $self = shift;
+
+ $self->sl("TRACE" . ($_[0] ? " $_[0]" : ""));
+}
+
+
+# -- #perl was here! --
+# <DragonFaX> Net::IRC is having my babies
+# <fimmtiu> DragonFax: Damn, man! She told me the child was MINE!
+# <Alpha232> Dragon: IRC has enough bastard children
+# <DragonFaX> IRC has enough bastards?
+# <fimmtiu> New Frosted Lucky Bastards, they're magically delicious!
+# <archon> they're after me lucky bastards!
+
+
+# Requests userhost info from the server.
+# Takes at least 1 arg: nickname(s) to look up.
+sub userhost {
+ my $self = shift;
+
+ unless (@_) {
+ croak 'Not enough args to userhost().';
+ }
+
+ $self->sl("USERHOST " . CORE::join (" ", @_));
+}
+
+# Sends a users request to the server, which may or may not listen to you.
+# Take 1 optional arg: the server to query.
+sub users {
+ my $self = shift;
+
+ $self->sl("USERS" . ($_[0] ? " $_[0]" : ""));
+}
+
+# Asks the IRC server what version and revision of ircd it's running. Whoop.
+# Takes 1 optional arg: the server name/glob. (default is current server)
+sub version {
+ my $self = shift;
+
+ $self->sl("VERSION" . ($_[0] ? " $_[0]" : ""));
+}
+
+
+# -- #perl was here! --
+# <vald> Does anyone know how to modify a perl server that accepts
+# telnet to make it accept emails ?
+# <TorgoX> vald -- do you know how to modify a car so that it has six
+# legs, spins webs, and eats flies?
+# <Schwern> Does a "perl server" serve perl?
+# <clintp> We all serve Perl. Some days, it serves us.
+
+
+# Sends a message to all opers on the network. Hypothetically.
+# Takes 1 arg: the text to send.
+sub wallops {
+ my $self = shift;
+
+ unless ($_[0]) {
+ croak 'No arguments passed to wallops()';
+ }
+
+ $self->sl("WALLOPS :" . CORE::join("", @_));
+}
+
+# Asks the server about stuff, you know. Whatever. Pass the Fritos, dude.
+# Takes 2 optional args: the bit of stuff to ask about
+# an "o" (nobody ever uses this...)
+sub who {
+ my $self = shift;
+
+ # Obfuscation!
+ $self->sl("WHO" . (@_ ? " @_" : ""));
+}
+
+# -- #perl was here! --
+# <\lembit> linda mccartney died yesterday, didn't she?
+# <q[merlyn]> yes... she's dead.
+# <q[merlyn]> WHY COULDN'T IT HAVE BEEN YOKO?
+
+
+# If you've gotten this far, you probably already know what this does.
+# Takes at least 1 arg: nickmasks or channels to /whois
+sub whois {
+ my $self = shift;
+
+ unless (@_) {
+ croak "Not enough arguments to whois()";
+ }
+ return $self->sl("WHOIS " . CORE::join(",", @_));
+}
+
+# -- #perl was here! --
+# <dnm> Fmh - do you want to telnet to one box and then ssh to another?
+# <Fmh> i realize an ssh proxy allows a man-in-the-middle attack.
+# <gargoyle> that sounds kinda pleasant right now
+# gargoyle goes off to find a set of twins
+# <amagosa> billn (=
+
+
+# Same as above, in the past tense.
+# Takes at least 1 arg: nick to do the /whowas on
+# (optional) max number of hits to display
+# (optional) server or servermask to query
+sub whowas {
+ my $self = shift;
+
+ unless (@_) {
+ croak "Not enough arguments to whowas()";
+ }
+ return $self->sl("WHOWAS $_[0]" . ($_[1] ? " $_[1]" : "") .
+ (($_[1] && $_[2]) ? " $_[2]" : ""));
+}
+
+
+# -- #perl was here! --
+# <veblen> On the first day, God created Shrimp.
+# * thoth parries the shrimp penis.
+# * [petey rofls
+# <veblen> On the second day, God created cocktail sauce.
+# <URanalog> "This is Chewbacca"
+# <Fmh> do not covet thy neighbor's shrimp.
+# * thoth pitches the shrimp penes on the barbie.
+# <thoth> UR: that's shrimp with penes, not shrimp with penne.
+
+
+# This sub executes the default action for an event with no user-defined
+# handlers. It's all in one sub so that we don't have to make a bunch of
+# separate anonymous subs stuffed in a hash.
+sub _default {
+ my ($self, $event) = @_;
+ my $verbose = $self->verbose;
+
+ # Users should only see this if the programmer (me) fucked up.
+ unless ($event) {
+ croak "You EEEEEDIOT!!! Not enough args to _default()!";
+ }
+
+ # Reply to PING from server as quickly as possible.
+ if ($event->type eq "ping") {
+ $self->sl("PONG " . (CORE::join ' ', $event->args));
+
+ } elsif ($event->type eq "disconnect") {
+
+ # I violate OO tenets. (It's consensual, of course.)
+ unless (keys %{$self->parent->{_connhash}} > 0) {
+ die "No active connections left, exiting...\n";
+ }
+ }
+
+ return 1;
+}
+
+
+
+# -- #perl was here! --
+# <fimmtiu> OK, once you've passed the point where caffeine no longer has
+# any discernible effect on any part of your body but your
+# bladder, it's time to sleep.
+# <fimmtiu> 'Night, all.
+# <regex> Night, fimm
+
+1;
+
+
+__END__
+
+=head1 NAME
+
+Net::IRC::Connection - Object-oriented interface to a single IRC connection
+
+=head1 SYNOPSIS
+
+Hard hat area: This section under construction.
+
+=head1 DESCRIPTION
+
+This documentation is a subset of the main Net::IRC documentation. If
+you haven't already, please "perldoc Net::IRC" before continuing.
+
+Net::IRC::Connection defines a class whose instances are individual
+connections to a single IRC server. Several Net::IRC::Connection objects may
+be handled simultaneously by one Net::IRC object.
+
+=head1 METHOD DESCRIPTIONS
+
+This section is under construction, but hopefully will be finally written up
+by the next release. Please see the C<irctest> script and the source for
+details about this module.
+
+=head1 AUTHORS
+
+Conceived and initially developed by Greg Bacon E<lt>gbacon@adtran.comE<gt> and
+Dennis Taylor E<lt>dennis@funkplanet.comE<gt>.
+
+Ideas and large amounts of code donated by Nat "King" Torkington E<lt>gnat@frii.comE<gt>.
+
+Currently being hacked on, hacked up, and worked over by the members of the
+Net::IRC developers mailing list. For details, see
+http://www.execpc.com/~corbeau/irc/list.html .
+
+=head1 URL
+
+Up-to-date source and information about the Net::IRC project can be found at
+http://netirc.betterbox.net/ .
+
+=head1 SEE ALSO
+
+=over
+
+=item *
+
+perl(1).
+
+=item *
+
+RFC 1459: The Internet Relay Chat Protocol
+
+=item *
+
+http://www.irchelp.org/, home of fine IRC resources.
+
+=back
+
+=cut
+
--- /dev/null
+ EXAMPLES
+ last updated 16.03.2000
+ written by xk
+
+<me> blootbot: test is testing
+<blootbot> me: okay
+<me> blootbot: testing?
+<blootbot> testing is testing
+
+<me> blootbot: tests is <REPLY> testing
+<blootbot> me: okay
+<me> blootbot: tests?
+<blootbot> testing
+
+<me> blootbot: cough is <ACTION> coughs
+<blootbot> me: okay
+<me> blootbot: cough
+* blootbot/#blootbot coughs
+
+<me> blootbot: test is <REPLY> What's (one|two|three|four|five|six)
+ times (seven|eight|nine|ten|eleven|twelve)?
+<blootbot> okay, me
+<me> blootbot: test
+<blootbot> What's four times nine?
+<me> blootbot: test?
+<blootbot> What's six times ten?
+
+<me> blootbot: op me is <ACTION> Mode change "+o $nick" on channel
+ $channel by $ident
+<blootbot> me: okay
+<me> blootbot: op me
+* blootbot/#debian-bots Mode change "+o me" on channel #blootbot by
+ blootbot
+
+<me> blootbot: no who am i is <REPLY> You are $nick!$user@$host on
+ $channel.
+<blootbot> okay, me
+<me> blootbot: who am i
+<blootbot> You are me!me@home.org on #blootbot.
+
+<me> blootbot: who last spoke is <REPLY> To my knowledge, $lastspeaker
+ was the last to say something worthwhile.
+<blootbot> me: okay
+<me> blootbot: who last spoke
+<blootbot> To my knowledge, me was the last to say something worthwhile.
+
+<me> blootbot: percentage is <REPLY> you are $randpercentage% lame
+<blootbot> me: okay
+<me> blootbot: percentage
+<blootbot> you are 79% lame
--- /dev/null
+Q: The bot exits after I run 'factstats testing' or 'kernel' or anything
+ that uses fork(). Is this a bug in the bot?
+
+A: No, this is not a bug in the bot but rather Net::IRC. A cheap hack is
+ to edit /usr/lib/perl5/Net/IRC/Connection.pm, search for DESTROY, and
+ comment out '$self->quit();'
+A: Apply the patches in the patches/ directory.
+
+
+Q: I notice that, in the bot logs, the bot attempts to close all current
+ DCC CHAT connections whenever a forked process ends. Why is this?
+
+A: Yet another bug in Net::IRC. Currently, DCC CHAT connections are not
+ closed because there is an endless-loop bug when it is done.
+
+
+Q: I executed 'scripts/setup_user.pl' but it said 'connection refused to
+ localhost'
+
+A: Looks like a bug in the installation of mysqld. You need to reload or
+ restart the daemon.
+ reload => 'mysqladmin -u root -p reload'
+ restart => '/etc/init.d/mysql stop; /etc/init.d/mysql start'
--- /dev/null
+##########################################################
+# Google.pm
+# by Jim Smyser
+# Copyright (C) 1996-1999 by Jim Smyser & USC/ISI
+# $Id$
+##########################################################
+
+
+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>.
+
+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.
+
+=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 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.
+<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.
+
+=head1 VERSION HISTORY
+
+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.10';
+
+$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(generic_option);
+require WWW::SearchResult;
+
+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
+
+# 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;
+ $url =~ s/\&exp\=OneBoxNews //g; # ~20000510.
+ $url =~ s/\&e\=110 //g; # -20000528.
+ $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 = $mDesc . $sDesc if (defined $mDesc);
+ $hit->description($sDesc) if (defined $hit and $sDesc ne '');
+ $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;
--- /dev/null
+######### TODO.
+### WISHLIST: SCHEDULER RELATED.
+- if topic -CMD is used, schedule the change for 10seconds later.
+ $schedule{topicchange}{$chan} = SID. use 'dequeue' to delete.
+- if 50% of netsplit victims come back, set a timer for 60seconds to
+ delete those who have not come back from the split.
+- make first run of schedulers skip so they don't run all at once.
+ use 'return' if (ref($_[0]) eq ???); => won't work?
+- use topic-queue for 'topic *'.
+- Add &schedulerAdd() and &schedulerDel();, &scheduleIsInQueue();
+- rename &ScheduleThis() to &scheduleAdd();
+
+### WISHLIST: COMMAND HOOKS.
+- play around with 'hook' idea, see header of CommandStubs.pl.
+- hook for ALL commands through MESSAGES.
+- factoids to take arguments such as $1 $2 ...
+ => check all factoids for hooks then append to hook list.
+
+### WISHLIST: OLDE DBM SUPPORT // PGSQL.
+- Thoroughly test both... core features done though.
+- make a sql_common.pl file for 90% common stuff between mysql/pgsql.
+- pgsql and mysql can be merged but I dunno anything about pgsql :)
+- PGSQL
+ - EVERYTHING
+- DBM
+ --- searchTable can be optimized by determining the correct offset
+ and use that from then on.
+ - Adding factoids [OK]
+ - Deleting factoids [OK]
+ - FactInfo [OK]
+ - Seen [OK]
+ - SearchTable [OK] -- "%","*" supported?
+ - Countdown [???]
+ - Freshmeat [???] -- &dbSetRow() should work, but slow.
+ - Factstats unrequested [???]
+
+### WISHLIST: SHOULD BE DONE...
+- Change ""return 'NOREPLY';"" to ""return $noreply;"".
+- make use of &status() in setup_*.pl
+- Add quotes (Finance::Quote) support.
+- Debian module doesn't search non-free or non-us properly.
+- send DCC message when using 'op'.
+- Schedule a 5min(??) interval to display stats in DCC
+ - kill if dcc chat == gone.
+- if 25lines are logged within 1 second, throttle it (sleep 1)
+- Add &botstatsUpdate() &botstatsGet();
+- Create startCheck(); for once off startup checks.
+- Max size of logs to keep.
+- split Process.pl's FactoidStuph() off to Factoids/FCommands.pl
+- time when last executed commands like fm,/. Useless?
+- if a dunno is issued, add an option to suggest a factiod
+ => IE: fm
+ - $fact =~ / blah|blah / or /\Wblah\W/ ??
+ - debian package. ??
+ - ...
+- add a function to evaluate channels
+ - ie: 'ALL', 'ALL but #blah', '#blah1 #blah2',
+ => Added &makeChanList() but not using it yet.
+- rename performStrictReply to performReplyAsIs() or something?
+- show current stats for top 3 requesters and top 3 requests.
+ => when seen is used, show last factoid/cmd asked
+- understand '\' in infobot.config.
+- Create a script to insert initial factoids like 'status','hello'...
+ like the dbm script in the old days.
+- Add 'heh' count, like on 'dpkg', to &on_public(). create generic table
+ to handle this and karma and probably total msg count. possibly
+ integrate with seen table?
+ .... UPDATE seen SET time=time+1 WHERE nick='xk';
+ .... ERROR 1064: parse error near '+1 WHERE nick='xk'' at line 1
+ => WHY?
+- support for 'find blah 6' for items 6 and more (since the list is
+ ordered). requested by jim.
+- support 'info package [dist] [section]', eg: 'info ssh non-free' or
+ support query for incoming, if dist!=incoming.
+- ...
+
+### WISHLIST: something to be desired...
+- 'tell' (Process.pl) to support commands.
+- reject '<REPLY> see' if redir factoid is too long.
+ need parsing of '||' and '(1|2|...)', too, for all possible
+ combinations (or permutations?).
+- download *.dsc and *.changes file to generate the Incoming Packages
+ file. This will be fun :)
+- Add 'OverwriteFromTxt' and other options for txt2mysql.pl.
+- Set some variable to say "yes, I'm quitting" to prevent log compression
+ since it imposes a perl warning "unreferenced scalar"...
+- Universal FROM<->TO conversion script for factoid table/db.
+### CLEAN UP
+- Split all the functions in Topic.pl to topic <COMMAND>. First chunk of
+ commands should be "Internal", the next chunk "Helpers" and the
+ last one is "Main".
+- Reduce number of global variables used.
+ => convert hash lists to arrays.
+ => convert scalar vars to hash lists.
+
+### CHALLENGE
+- Better method to store topics. Should be very similiar to the
+ joinnextchan code, but a topic queue. _however_, topic may be lost with
+ netsplit + stuff which is another problem, oh well.
+ How do IRC clients do it? set a timer for 0.5s before any changes?
+- Tree to show all variables in use. preliminary stuff there but
+ it's not all that helpful. good oreilly stuff in scripts/
+- Better netjoin detection code.
+- Allow X number of repetition of messages, default cannot be changed due
+ to simplicity of current code.
+
+### EXTERNAL BUGS:
+- Net::IRC doesn't know event 'pong'.
+
+### BROKEN:
+- babelfish
--- /dev/null
+==========================================================================
+= === ======== ==== === == ==== === =
+= === == ======= === == === ===== ===== === == === ===== ====
+= === ======= === == === ===== ===== === === ===== ====
+= === == ======= === == === ===== ===== === == === ===== ====
+= === === ==== ====== ===== ==== ====== ====
+==========================================================================
+
+ ======================================
+ USER COMMANDS
+ ======================================
+
+Command: 4op
+=============
+Description:
+ ...
+
+Usage: REQUIRES +o flag.
+ 4op ...
+
+Example:
+ ...
+
+
+Command: dumpvars
+=============
+Description:
+ ...
+
+Usage: REQUIRES +o flag.
+ dumpvars ...
+
+Example:
+ ...
+
+
+Command: kick
+=============
+Description:
+ ...
+
+Usage: REQUIRES +o flag.
+ kick ...
+
+Example:
+ ...
+
+
+Command: ignore
+=============
+Description:
+ ...
+
+Usage: REQUIRES +o flag.
+ ignore ...
+
+Example:
+ ...
+
+
+Command: ignorelist
+=============
+Description:
+ ...
+
+Usage: REQUIRES +o flag.
+ ignorelist ...
+
+Example:
+ ...
+
+
+Command: unignore
+=============
+Description:
+ ...
+
+Usage: REQUIRES +o flag.
+ unignore ...
+
+Example:
+ ...
+
+
+Command: clear ignorelist
+=============
+Description:
+ ...
+
+Usage: REQUIRES +o flag.
+ clear ignorelist ...
+
+Example:
+ ...
+
+
+Command: lobotomy
+=============
+Description:
+ ...
+
+Usage: REQUIRES +o flag.
+ lobotomy ...
+
+Example:
+ ...
+
+
+Command: unlobotomy
+=============
+Description:
+ ...
+
+Usage:
+ unlobotomy ...
+
+Example:
+ ...
+
+
+Command: op
+=============
+Description:
+ ...
+
+Usage: REQUIRES +o flag.
+ op ...
+
+Example:
+ ...
+
+
+Command: say
+=============
+Description:
+ ...
+
+Usage: REQUIRES +o flag.
+ say ...
+
+Example:
+ ...
+
+
+Command: die
+=============
+Description:
+ ...
+
+Usage: REQUIRES +n flag.
+ die ...
+
+Example:
+ ...
+
+
+Command: jump
+=============
+Description:
+ ...
+
+Usage: REQUIRES +n flag.
+ jump ...
+
+Example:
+ ...
+
+
+Command: rehash
+=============
+Description:
+ ...
+
+Usage: REQUIRES +n flag.
+ rehash ...
+
+Example:
+ ...
+
+
+Command: set
+=============
+Description:
+ ...
+
+Usage: REQUIRES +n flag.
+ set ...
+
+Example:
+ ...
+
+
+Command: unset
+=============
+Description:
+ ...
+
+Usage: REQUIRES +n flag.
+ unset ...
+
+Example:
+ ...
+
+
+Command: chanstats
+=============
+Description:
+ Channel statistics is gathered while the bot is operation in those
+ channels it is located. They include: join, part, kick, ban, and
+ countless others.
+
+Usage:
+ chanstats [#channel]
+
+Example:
+ > blootbot: chanstats
+ <blootbot> i am on 2 channels: #blootbot #debian
+ <blootbot> i've cached 5 users distributed over 2 channels.
+
+ > blootbot: chanstats #blootbot
+ <blootbot> On #blootbot, there have been 1 Join, 1 Op and 20
+ PublicMsgs.
+ <blootbot> At the moment, 3 Opped and 3 Total.
+
+
+Command: cmdstats
+=============
+Description:
+ ...
+
+Usage:
+ cmdstats ...
+
+Example:
+ ...
+
+
+Command: crypt
+=============
+Description:
+ ...
+
+Usage:
+ crypt ...
+
+Example:
+ ...
+
+
+Command: factinfo
+=============
+Description:
+ ...
+
+Usage:
+ factinfo ...
+
+Example:
+ ...
+
+
+Command: factstats
+=============
+Description:
+ ...
+
+Usage:
+ factstats ...
+
+Example:
+ ...
+
+
+Command: karma
+=============
+Description:
+ ...
+
+Usage:
+ karma ...
+
+Example:
+ ...
+
+
+Command: spell
+=============
+Description:
+ ...
+
+Usage:
+ spell ...
+
+Example:
+ ...
+
+
+Command: nslookup
+=============
+Description:
+ ...
+
+Usage:
+ nslookup ...
+
+Example:
+ ...
+
+
+Command: part
+=============
+Description:
+ ...
+
+Usage:
+ part ...
+
+Example:
+ ...
+
+
+Command: rot13
+=============
+Description:
+ ...
+
+Usage:
+ rot13 ...
+
+Example:
+ ...
+
+
+Command: wantNick
+=============
+Description:
+ ...
+
+Usage:
+ wantNick ...
+
+Example:
+ ...
+
+
+Command: join
+=============
+Description:
+ The bot can be commanded to join a channel if it is not already on
+ there in the case of a kick/ban, invite only or invalid key to
+ name a few typical case scenarios.
+
+ The channels which the bot can join is governed by the
+ configuration parameter labelled 'join_channels'. However, this
+ is ignored for those users with the +o flag in the user table.
+
+Usage:
+ join <#channel>[,key]
+
+Example:
+ > blootbot: join #blootbot
+ [blootbot] joining #blootbot
+ *** join/#debian blootbot (xk@router.home.org)
+ > blootbot: join #blootbot
+ [blootbot] I'm already on #blootbot...
+
+
+
+ ======================================
+ MODULE COMMANDS
+ ======================================
+
+Command: babelfish
+=============
+Description:
+ ...
+
+Usage:
+ x from [language]: phrase
+
+Example:
+ ...
+
+
+Command: debian package
+=============
+Description:
+ ...
+
+Usage:
+ [] ...
+
+Example:
+ ...
+
+
+Command: dict
+=============
+Description:
+ ...
+
+Usage:
+ dict ...
+
+Example:
+ ...
+
+
+Command: freshmeat
+=============
+Description:
+ ...
+
+Usage:
+ freshmeat ...
+
+Example:
+ ...
+
+
+Command: google
+=============
+Description:
+ ...
+
+Usage:
+ google ...
+
+Example: DOES NOT WORK YET(??)
+ ...
+
+
+Command: insult
+=============
+Description:
+ ...
+
+Usage:
+ insult ...
+
+Example:
+ ...
+
+
+Command: kernel
+=============
+Description:
+ ...
+
+Usage:
+ kernel ...
+
+Example:
+ ...
+
+
+Command: lart
+=============
+Description:
+ ...
+
+Usage:
+ lart ...
+
+Example:
+ ...
+
+
+Command: list{keys|vals}
+=============
+Description:
+ ...
+
+Usage:
+ list{keys|vals} ...
+
+Example:
+ ...
+
+
+Command: nickometer
+=============
+Description:
+ ...
+
+Usage:
+ nickometer ...
+
+Example:
+ ...
+
+
+Command: quotes
+=============
+Description:
+ ...
+
+Usage:
+ quotes ...
+
+Example:
+ ...
+
+
+Command: rootwarn
+=============
+Description:
+ ...
+
+Usage:
+ rootwarn ...
+
+Example:
+ ...
+
+
+Command: seen
+=============
+Description:
+ ...
+
+Usage:
+ seen ...
+
+Example:
+ ...
+
+
+Command: listauth
+=============
+Description:
+ ...
+
+Usage:
+ listauth ...
+
+Example:
+ ...
+
+
+Command: slashdot
+=============
+Description:
+ ...
+
+Usage:
+ slashdot ...
+
+Example:
+ ...
+
+
+Command: debian contents
+=============
+Description:
+ ...
+
+Usage:
+ debian ...
+
+Example:
+ ...
+
+
+Command: topic
+=============
+Description:
+ ...
+
+Usage:
+ topic ...
+
+Example:
+ ...
+
+
+Command: countdown
+=============
+Description:
+ ...
+
+Usage:
+ countdown ...
+
+Example:
+ ...
+
+
+Command: uptime
+=============
+Description:
+ ...
+
+Usage:
+ uptime ...
+
+Example:
+ ...
+
+
+Command: weather
+=============
+Description:
+ ...
+
+Usage:
+ weather ...
+
+Example: DOES NOT WORK
+ ...
+
+
+Command: whatis
+=============
+Description:
+ ...
+
+Usage:
+ whatis ...
+
+Example: DOES NOT WORK
+ ...
+
+
+
+ ======================================
+ MISCELLANEOUS/FACTOID COMMANDS
+ ======================================
+
+Command: forget
+=============
+Description:
+ ...
+
+Usage:
+ forget ...
+
+Example:
+ ...
+
+
+Command: {un|}lock
+=============
+Description:
+ ...
+
+Usage:
+ {un|}lock ...
+
+Example:
+ ...
+
+
+Command: rename
+=============
+Description:
+ ...
+
+Usage:
+ rename ...
+
+Example:
+ ...
+
+
+Command: substitution
+=============
+Description:
+ ...
+
+Usage:
+ $factoid =~ s/from/to/
+ $factoid =~ s#te/st/#test#g
+
+Example:
+ ...
+
+
+Command: karma set
+=============
+Description:
+ ...
+
+Usage:
+ $nick++
+ $nick--
+
+Example:
+ blootbot++
+ infobot--
+
+
+Command: maths
+=============
+Description:
+ ...
+
+Usage:
+ 2 + 2
+
+Example:
+ ...
+
+
+Command: tell
+=============
+Description:
+ ...
+
+Usage:
+ tell <nick> about <factoid>
+
+Example:
+ ...
--- /dev/null
+### FILE ### STATE
+Files.pl - GOOD
+Irc.pl - split into another file?
+IrcHooks.pl - move hook* to another file like ^^?
+Math.pl - stock'ish infobot
+Misc.pl - remove checkPing, move Forker to Fork.pl,
+ move *seen* to Seen.pl
+Modules.pl - design hooks for commands, using hash to enable
+ options like help,fork,...
+Net.pl - too much debugging info
+Norm.pl - stock'ish infobot
+PerlMod.pl - move to loadmods.pl (core), move related
+ functions to this file aswell.
+Process.pl - convert to use hooks.
+Question.pl - stock'ish infobot.
+Reply.pl - stock'ish infobot.
+SQL.pl - GOOD, move factoid stuff to SQLExtra.pl?
+SQLExtra.pl - GOOD.
+Schedulers.pl - GOOD but a little disorganised.
+Shm.pl - move fork* to Fork.pl
+Statement.pl - stock'ish infobot.
+Update.pl - stock'ish infobot.
+User.pl - GOOD.
+UserExtra.pl - convert to use hooks?
+core.pl - move load-module stuff to loadmods.pl?
+interface.pl - move to core.pl?
+logger.pl - GOOD.
+Modules/Countdown.pl -
+Modules/DNS.pl -
+Modules/Debian.pl -
+Modules/DebianExtra.pl -
+Modules/Dict.pl -
+Modules/DumpVars.pl -
+Modules/Factoids.pl -
+Modules/Freshmeat.pl -
+Modules/Kernel.pl -
+Modules/Quote.pl -
+Modules/RootWarn.pl -
+Modules/Search.pl -
+Modules/Slashdot3.pl -
+Modules/Topic.pl -
+Modules/Units.pl -
+Modules/Uptime.pl -
+Modules/UserInfo.pl -
+Modules/W3Search.pl -
+Modules/WhatIs.pl -
+Modules/Wingate.pl -
+Modules/babel.pl -
+Modules/insult.pl -
+Modules/nickometer.pl -
--- /dev/null
+TABLE factoids
+ factoid key
+ CHAR($param{'maxKeySize')
+ max 256
+
+ factoid value
+ TEXT
+ max 65535
+
+ requested who by
+ CHAR(80)
+ max 256
+
+ requested time
+ INT
+ max 2147483647
+
+ requested count
+ SMALLINT UNSIGNED
+ max 65535
+
+ created who by
+ CHAR(80)
+ max 256
+
+ created time
+ INT
+ max 2147483647
+
+ modified who by
+ CHAR(80)
+ max 256
+
+ modified time
+ INT
+ max 2147483647
+
+ locked who by
+ CHAR(80)
+ max 256
+
+ locked time
+ INT
+ max 2147483647
+
+######
+######
+###### TODO
+######
+######
+
+* make factoid_key index of table and only allow unique factoid_key
+ values in table.
--- /dev/null
+##### GLOBAL VARIABLES
+### Scalar variable.
+$who => Process.pl#7:
+$msgType => Process.pl#7:
+$message => Process.pl#7:
+$origWho => Process.pl#12: untouched $who variable.
+$origMessage => Process.pl#13: untouched $message variable.
+$origIn => Question.pl#15: (my) successful (not repeated) asked factoid
+$who => Process.pl#6:
+$message => Process.pl#6:
+$nuh => Irc.pl#279: nick-user-host
+$userHandle => User.pl: handle which nick is registered under.
+### Array.
+### Hash lists.
+%channels => $channels{$channel}{$mode}{$nick}
+%chanstats => $chanstats{$channel}{TYPE}
+%cmdstats => $cmdstats{TYPE}
+%userList => $userList{$user}{$type}
+%userList => $userList{$user}{'mask'}{$what} = 1;
+#####
+
+### Thorough check and cleanup of... (comments need to be read though)
+Process.pl 19991128
+Irc.pl 19991128
+Misc.pl 19991128
+
+
+
+### Address testing with the "new" code.
+### nick == $1, text = $'
+blah erp good
+blah erp erp good
+blah:erp good... about time got it to work.
+blah:erp erp good... ditto
+blah :erp good
+blah :erp erp good
+blah : erp good
+blah : erp erp good
+blah : erp good
+blah : erp erp good
+blah : erp good
+blah : erp erp good
+
+unfski erp good
+unfski erp erp good
+unfski:erp hrm... good :)
+unfski:erp erp hrm... good :)
+unfski :erp good
+unfski :erp erp good
+unfski : erp good
+unfski : erp erp good
+unfski : erp good
+unfski : erp erp good
+unfski : erp good
+unfski : erp erp good
+
+### some notes...
+&DoModes($chan,$modes,$targets);
+&DeleteUserInfo($nick,@chans);
+# NOTE: subhash list can only be deleted with "delete" not with "undef".
+foreach $chan (keys %channels) {
+foreach $mode (keys %{$channels{$chan}}) {
+foreach $user (keys %{$channels{$chan}{$mode}}) {
+
+### &DeleteUserInfo().
+# DUI: type working fix
+# part yes undef=>delete
+# sign yes fe loops=>DUI($n,%c);
+# nick yes undef=>delete
+# kill ... ...
+###
+
+###
+### Soon to be new format of factoid.db, or at least infobot-extra.db
+###
+[factoid key] -> [created].[modified].[requests].[locked]
+ | | | |
+ [who by] [who by] [who by] [who by]
+ [time] [time] [time] [time]
+ [count]
+
+$db{'key'} = $created_by .$;. $created_time .$;$;.
+ $modified_by .$;. $modified_time .$;$;.
+ $request_by .$;. $request_time .$;. $request_count .$;$;.
+ $locked_by .$;. $locked_time;
+
+factoid can only be unlocked by creator. possibly need to be matched
+against nick || user@*.x.org || user@x.y.z.*
+
+#####
+# forget: factoid locking half-done TODO
+# factoid query DONE.
+# factoid update (2 create; 4 modify) DONE.
+#####
+
+raw: ..... KICK #tnflesh damagick :i can do this too
+940445681 [12632] >>> [1mtoo[0m was kicked off [1m#tnflesh damagick :i \
+ can do this[0m by [1mChimmy[0m ([1mP[0m)
+my ($kicker, $chan, $knick, $why) = @_;
+ $1 $2 $4 $5
+
+("Op", yes
+"Deop", yes
+"Ban", yes
+"Unban", yes
+"Topic", yes
+"Kick", yes
+"PublicMsg" yes
+"Part", yes
+"SignOff", yes
+"Join" yes
--- /dev/null
+##### EXAMPLE 1
+insert into customers values (0, 'MrHanky');
+insert into customers values (1, 'Chef');
+
+##### EXAMPLE 2
+my $query = $conn->prepare(
+ "SELECT first_name, last_name, hired_at" .
+ " FROM employees" .
+ " ORDER BY last_name, first_name"
+ );
+$query->execute();
+
+print sprintf("%-40s%-20s", "Name:", "Hired At:"), "\n";
+print "-" x 60 . "\n";
+while (@row = $query->fetchrow_array())
+{
+ ($first_name, $last_name, $hired_at) = @row;
+
+ print sprintf("%-40s%-20s", $first_name . " " . $last_name,
+$hired_at),
+ "\n";
+}
+
+undef($query);
+$conn->disconnect();
+$conn = undef;
+
+##### EXAMPEL 3.
+
--- /dev/null
+# parameter settings file for the infobot
+# kevin lenzo (lenzo@cs.cmu.edu)
+# modified by xk <xk@leguin.openprojects.net>
+###
+
+# [str] Interface: [IRC/CLI]
+set Interface IRC
+
+# IRC.
+set ircNick InfoCup
+set ircUser MrInfo
+set ircName Mmmm Tasty Info
+set ircUMode +iw
+set join_channels #DEBIAN-bots #Odd
+
+# nickserv/chanserv support.
+###set nickServ_pass PASSWORD
+###set chanServ_ops #chan1 #chan2
+
+# default quit message
+set quitMsg BEE RICHT BAK
+
+#####
+# logfile
+#####
+
+# [file] where to put logging info. comment out to disable.
+set logfile log/$ircUser.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 DB Configuration
+#####
+
+# [str] Ability to remember/tell factoids
+# none -- disable.
+# mysql -- ...
+# pgsql -- postgresql (NOT SUPPORTED)
+# dbm -- berkeley dbm (NOT SUPPORTED)
+set DBType mysql
+
+# [str] DBM filename prefix // MYSQL/PGSQL database.
+# eg: blootbot-factoids, blootbot-seen
+# eg: /var/db/mysql/blootbot/factoids.*
+set DBName botdb
+
+# [str] Hostname of database server
+set SQLHost localhost
+
+# [str] mysql user allowed to insert,update,delete stuff from tables.
+set SQLUser root
+
+# [str] mysql password.
+set SQLPass ynnadpmp
+
+#####
+# factoid-related configuration
+#####
+
+# [bool] Factoid support.
+set factoids true
+
+# [int] maximum length of factoid key.
+set maxKeySize 32
+
+# [int] maximum length of factoid value.
+set maxDataSize 450
+
+# [int] minimum length of unaddressed (message) question without question
+# before it is answered involuntarily.
+# This ignores the 'addressing' setting.
+# 0 to disable.
+set minVolunteerLength 0
+
+# [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. I tried this ages
+# ago and it caught quite funny responses but who knows
+# if my modifications will prevent this or not, perhaps
+# IsInvalid must be disabled?
+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
+
+# [0/1] tell so-and-so about such-and-such of a factoid.
+set allowTelling 1
+
+# [bool] profanity checking.
+set profanityCheck false
+
+# [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
+
+# should work. FIXME.
+set addressCharacter ~
+
+# [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
+
+# [int] maximum length of reply for Extras function before popping list to
+# reduce number of elements.
+set maxListReplyLength 300
+
+# [int] maximum number of elements in list allowed for Extras function
+# before popping elements to reduce total count.
+set maxListReplyCount 15
+
+# [0/1] allow people outside any channels the bot is on to use the bot
+# for factoids and commands.
+set disallowOutsiders 1
+
+# [int] time, in seconds. (different messages)
+set floodMessages 10:30
+# [int] same messages.
+set floodRepeat 2:10
+
+# [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] irc-cli calculator.
+set perlMath 1
+
+# [0/1] ord/chr etc
+set allowConv 1
+
+# [0/1] do you want to allow DNS lookup
+set allowDNS 1
+
+# [0/1] Forking... enable for non-nix OS or to reduce mem usage.
+# This should work for Win32 and MacOS. About time, hey :)
+set forking 1
+
+# [int] Backlog... ideal to see what happened to the bot on console.
+# maximum number of lines to backlog.
+set backlog 24
+
+#####
+# Miscellaneous...
+#####
+
+# [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 1
+
+# [0/1] Work In Progress...
+set WIP 1
+
+# debugging...
+###set dumpvars 1
+###set dumpvarsAtExit 1
+# log to specific file or global log file.
+###set dumpvarsLogFile dumpvars.log
+
+# [0/1] allow 'use strict', makes bot unreliable.
+set useStrict 0
+
+#####
+# Extras
+#####
+
+# [str] anything which requires LWP + http proxy.
+# set httpProxy http://router.home.org:3128/
+
+# [0/1] babelfish translator. jdf++.
+set babelfish true
+
+# [0/1] offer free factoid cookies
+set cookie true
+
+# [0/1] Countdown to specific dates
+set countdown true
+
+# [0/1] Debian file and package search.
+set debian true
+# [int] how often to update the debian table, in days.
+set debianRefreshInterval 7
+# [0/1] extra stuff...
+set debianExtra true
+
+# [0/1] Frontend to dict.org's wordnet.
+set dict true
+
+# [0/1] Freshmeat
+set freshmeat true
+
+# [int] how often to update the freshmeat table, in hours.
+set freshmeatRefreshInterval 2
+
+# [chans|all] 10items/hour, might be annoying.
+###set freshmeatAnnounce #debian-bots
+# [bool] if factoid does not exist, check freshmeat for it.
+set freshmeatForFactoid false
+
+# [0/1] insult server
+set insult false
+
+# [0/1] karma
+set karma true
+
+# [0/1] Frontend to kernel.org
+set kernel true
+set kernelAnnounce #debian-bots
+
+# [0/1] LART.
+set lart true
+
+# [array] Channel limit adjuster. List of channels.
+set limitcheck #debian-bots
+# [int] Interval (or more than), in minutes.
+set limitcheckInterval 30
+# [int] Adjust channel limit to 10 above total users in channel.
+set limitcheckPlus 10
+
+# [0/1] nickometer
+set nickometer true
+
+# [0/1] Frontend to the stock market.
+set quote true
+
+# [0/1] Display random text in the channel.
+set randomQuote false
+
+# [str] Channels.
+set randomQuoteChannels #debian-bots
+
+# [int] Interval (or more than), in minutes.
+set randomQuoteInterval 60
+
+# [0/1] Display random text in the channel.
+set randomFactoid false
+
+# [str] Channels.
+set randomFactoidChannels #debian-bots
+
+# [int] Interval (or more than), in minutes.
+set randomFactoidInterval 60
+
+# [0/1] Warn users about root.
+###set rootWarn true
+# passive -- be polite plus stuff, compliant to OPN, heh.
+# aggressive -- ...
+###set rootWarnMode passive
+
+# [0/1] Factoid search.
+set search true
+
+# [0/1] persistant "seen". WARNING: this may cause memory leaks.
+set seen true
+
+# [0/1] seen statistics for online users like idle time, total message
+# count.
+set seenStats true
+
+# [int] if someone's been away for more than xx days, delete their info.
+# info.
+set seenMaxDays 90
+
+# [int] interval to flush cached seen info. in minutes.
+set seenFlushInterval 60
+
+# [0/1] slashdot headlines.
+set slashdot true
+set slashdotAnnounce #debian-bots
+
+# [0/1] frontend to ispell.
+set spell true
+
+# [0/1] Advanced topic management.
+set topic true
+
+# [0/1] User Information Services.
+set userinfo true
+
+# [0/1] Uptime daemon
+set uptime true
+
+# [0/1] weather.com. FIXME
+set weather false
+
+# [str] Wingate checking and banning mechanism.
+###set wingate #debian
+# [int] seconds. minimum time to check.
+set wingateInterval 60
+# [str] Wingate.
+set wingateBan true
+# [str] Wingate.
+set wingateKick DIE DIE DIE
+
+# google search.. simon++ . expanded to www search using several
+# engines since it was so easy once you have WWW::Search.
+# use "update" if you want it to update the db, or comment
+# out if you don't want it. requires WWW::Search, not included.
+# use "forceupdate" to force a db update on every google search.
+# [0/1]
+set wwwsearch true
+
+# [0/1] Unit conversion tool.
+set units true
--- /dev/null
+# Revised: 19991109.
+# Author: xk
+###
+
+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?"
+
+author: oznoid (mailto:lenzo@ri.cmu.edu) is my original author.
+
+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 ..."
+
+action: This is used to override the usual response. "x is <REPLY> does the hokey-pokey". When asked about x, the bot does this "* infobot does the hokey-pokey"
+
+reply: There is a special tag, <reply>, 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 <reply> Y".
+reply: This is a good way to close junk entries; use "X is <reply>" with nothing after it.
+
+alternation: The || symbol in an entry causes an infobot to choose one of the replies at random. "X is Y|Z" will produce "X is Y" or "X is Z" randomly.
+
+# now the commands...
+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
+
+unlobotomy: which is not possible in real life, an unlobotomy will bring me back to life in the case of a lobotomy.
+
+addressing: it is a good idea if i stay in REQUIRE mode then i won't yell out random crap if i listen in too hard. currently there is no way to turn this of on-the-fly.
+
+forget: FIXME
+
+find: D: Debian Packages (fallback to Contents) Search
+find: U: ## [dcc] [dist] <string>
+find: E: ## strings.h
+find: E: ## dcc usr/bin
+find: E: ## slink x11amp
+
+rename: D: Factoid renaming.
+rename: U: ## 'from' 'to'
+rename: E: ## 'infobot' 'blootbot'
+
+nslookup: D: Query DNS.
+nslookup: U: ## <host|ip>
+nslookup: E: ## debian.org
+nslookup: E: ## 3.1.33.7
+
+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.
+
+crypt: it's good that you thought about encryption. i can do it for you.
+crypt: U: ## <string> <salt>
+crypt: E: ## changeme 69
+
+join: U: ## <#chan> [key]
+join: E: ## #debian
+join: E: ## #debian rules
+
+kick: U: ## <nick> [#chan]
+kick: E: ## oznoid
+kick: E: ## larne #debian
+
+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).
+
+chaninfo: D: Display channel statistics on Op, Ban, Deop, Unban, Part, Join, SignOff, PublicMsg, Kick and Topic.
+chaninfo: U: ## [#channel]
+chaninfo: E: ##
+chaninfo: E: ## #debian
+
+dict: D: DICT Protocol Client.
+dict: U: ## <query>
+dict: E: ## AI
+dict: E: ## 1 linux
+
+freshmeat: D: Frontend to www.freshmeat.net
+freshmeat: U: ## <query>
+freshmeat: E: ## infobot
+
+factstats: D: Display statistical data (max of 15) about factoids.
+factstats: U: ## <type>
+factstats: == author -- top author of factoids.
+factstats: == broken -- broken factoids.
+factstats: == dupe -- duplicate factoids.
+factstats: == locked -- locked factoids.
+factstats: == new -- recent addition of factoids.
+factstats: == partdupe -- initial partial duplicate factoids.
+factstats: == profanity -- possibly offensive factoids.
+factstats: == redir -- redirection in factoids.
+factstats: == requested -- most requested factoids.
+factstats: == toolong -- factoid {key|value} exceeding specified length.
+factstats: == unrequest -- unrequested factoids.
+factstats: E: ## new
+
+lart: D: Luser Attitude Readjustment Tool
+lart: U: ## [#chan] <who>
+lart: E: ## lenzo infobot's bugginess
+lart: E: ## #perl everyone perl \=\= lamerville
+
+listauth: D: Search the factoid extension db by creator.
+listauth: U: ## <search>
+listauth: E: ## xk
+
+listkeys: D: Search the factoid database by key (factoid).
+listkeys: U: ## <regex>
+listkeys: E: ## infobot
+
+listvalues: D: Search the factoid database by value (description).
+listvalues: U: ## <regex>
+listvalues: E: ## infobot
+
+quote: D: Frontend to yahoo's online stock market share listing.
+quote: U: ## <query>
+quote: E: ## RHAT
+
+weather: D: Frontend to www.weather.com.
+weather: U: ## <query>
+weather: E: ## Sydney
+weather: E: ## Perth, Australia
+weather: N: For first timers, please search for the city as all search results are kept in the local cache. You can then query 'city, location'.
+
+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 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: 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.
+
+part: U: ## <#channel>
+part: E: ## #debian
+
+seen: U: ## <nick>
+seen: E: ## infobot
+
+factinfo: D: View statistical information about a particular factoid.
+factinfo: U: ## <factoid>
+factinfo: E: ## test
+
+cookie: i can feed your appetite with random factoids.
+
+slashdot: D: News for nerds, Stuff that matters. [tm]
+slashdot: U: ##
+
+babelfish: D: Frontend to babelfish translating service provided by digital.com
+babelfish: U: x to <lang>: <words>
+babelfish: U: translate from <lang>: <words>
+babelfish: E: x to de: your cars rock
+
+insult: FIXME
+
+search: U: ## <engine> for <string>
+search: E: ## google for evil
+
+nickometer: FIXME
+
+rot13: FIXME
+
+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: ##
+
+maths: FIXME
+
+lock: D: Factoid locking to prevent removal by others.
+lock: U: ## <factoid>
+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.
+
+unlock: D: Factoid unlocking to allow removal by others.
+unlock: U: ## <factoid>
+unlock: E: ## abuse
+
+dollar variables: D: To be used in factoids
+dollar variables: $date - ...
+dollar variables: $time - ...
+dollar variables: $who - ...
+dollar variables: $username - ...
+dollar variables: $host - ...
+dollar variables: $channel - ...
+dollar variables: $lastspeaker - ...
+dollar variables: $factoid - ...
+dollar variables: ... - ...
--- /dev/null
+# infobot.ignore file.
+# examples.
+
+# ignore public messages from...
+PUBLIC dpkg!*@*.com
+
+# ignore all messages from...
+ALL *!*@*.il
+
+# ignore private messages from
+PRIVATE apt!*@*
--- /dev/null
+# infobot.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
+
+# 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?
+
+# 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
+
+# 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 is
+ what are
+ where
+ where is
+ where are
--- /dev/null
+
+#
+# lart info by ejb (larne) and cerb.
+#
+
+--purges WHO
+beats WHO senseless with a 50lb Unix manual
+cats /dev/urandom into WHO's ear
+chops WHO in half with a free AOL CD
+chops WHO in half with a free Solaris 7 CD
+decapitates WHO conan the destroyer style
+does a little 'renice 20 -u WHO'
+drops a truckload of VAXen on WHO
+duct-tapes WHO to the floor and drools on him
+frags WHO with his BFG9000
+holds WHO to the floor and spanks him with a cat-o-nine-tails
+judo chops WHO
+pours hot grits down the front of WHO's pants
+pulls out his louisville slugger and uses WHO's head to break the homerun record
+pushes the wall down onto WHO whilst whistling innocently
+resizes WHO's terminal to 40x24
+rm -rf's WHO
+stabs WHO
+steals WHO's mojo
+strangles WHO with a doohicky mouse cord
+urinates on WHO
+whacks WHO with the cluebat
+whips out a sword and chops WHO in half
+whips out his power stapler and staples WHO's genitalia to the ground
--- /dev/null
+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 Fahrvergn\ 1ugen 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 \ 1\ 2\ 1\ 2
+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 de\ 2ja\ 5 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-l\ 4inz \ 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.
--- /dev/null
+#
+# User File (c) 1998 Infobot & Associates
+#
+# FLAGS
+# ---------------------- Factoids.
+# f multiple line factoid (MLF) Usage Allowed [UNTESTED,OLD?]
+# m Modifying (mod) Allowed
+# r Removing (del) Allowed
+# t Teaching (add) Allowed
+# ----------------------
+# i Ignore Flag level 0
+# o Op Flag level 1
+# n Owner Flag level 2
+# e Extra Privs level 3
+# ----------------------
+
+###
+# default is to allow modification, removal and addition of factoids,
+# if factoid support is enabled.
+UserEntry default {
+ flags +mrt;
+}
+
+###
+# Sample user entry with all the flags.
+UserEntry GmLB {
+ name "Danny";
+ title "Grand Master";
+ flags +mrsteon;
+ pass ECovKDtJnED36;
+}
--- /dev/null
+# ircII.servers file for infobot.
+
+irc.linux.com
+irc.openprojects.net
--- /dev/null
+# parameter settings file for the infobot
+# kevin lenzo (lenzo@cs.cmu.edu)
+# modified by xk <xk@leguin.openprojects.net>
+###
+
+# [str] Interface: [IRC/CLI]
+set Interface IRC
+
+# IRC.
+set ircNick blootbot
+set ircUser blootbot
+set ircName blootbot experimental bot
+set ircUMode +iw
+###set ircHost vh.virtualhost.org
+set join_channels #DEBIAN-bots
+
+# nickserv/chanserv support.
+###set nickServ_pass PASSWORD
+###set chanServ_ops #chan1 #chan2
+
+# default quit message
+set quitMsg adios amigos
+
+#####
+# logfile
+#####
+
+# [file] where to put logging info. comment out to disable.
+set logfile log/$ircUser.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 DB Configuration
+#####
+
+# [str] Ability to remember/tell factoids
+# none -- disable.
+# mysql -- ...
+# pg -- postgresql (NOT SUPPORTED)
+# dbm -- berkeley dbm (NOT SUPPORTED)
+### REQUIRED by factoids,freshmeat,karma,seen,...
+set DBType mysql
+
+# [str] DBM filename prefix // MYSQL/PGSQL database.
+set DBName blootbot
+
+# [str] Database name on server.
+set SQLName blootbot
+
+# [str] Hostname of database server
+set SQLHost localhost
+
+# [str] mysql user allowed to insert,update,delete stuff from tables.
+set SQLUser blootbot
+
+# [str] mysql password.
+set SQLPass PASSWORD
+
+#####
+# factoid-related configuration
+#####
+
+# [bool] Factoid support.
+set factoids true
+
+# [int] maximum length of factoid key.
+set maxKeySize 32
+
+# [int] maximum length of factoid value.
+set maxDataSize 450
+
+# [int] minimum length of unaddressed (message) question without question
+# before it is answered involuntarily.
+# This ignores the 'addressing' setting.
+# 0 to disable.
+set minVolunteerLength 0
+
+# [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. I tried this ages
+# ago and it caught quite funny responses but who knows
+# if my modifications will prevent this or not, perhaps
+# IsInvalid must be disabled?
+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
+
+# [char] One-character easy recognition.
+set addressCharacter ~
+
+# [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. Value of '1' has same behaviour as superseeded
+# option 'preferReply PRIVATE'.
+# "+" before bot commands overrides this option temporarily.
+###set minLengthBeforePrivate 192
+
+# [int] maximum length of reply for Extras function before popping list to
+# reduce number of elements.
+set maxListReplyLength 450
+
+# [int] maximum number of elements in list allowed for Extras function
+# before popping elements to reduce total count.
+set maxListReplyCount 15
+
+# [0/1] allow people outside any channels the bot is on to use the bot
+# for factoids and commands.
+set disallowOutsiders 1
+
+# [int] time, in seconds. (different messages)
+set floodMessages 10:30
+# [int] same messages.
+set floodRepeat 2:10
+
+# [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] irc-cli calculator.
+set perlMath 1
+
+# [0/1] ord/chr etc
+set allowConv 1
+
+# [0/1] do you want to allow DNS lookup
+set allowDNS 1
+
+# [0/1] Forking... enable for non-nix OS or to reduce mem usage.
+# This should work for Win32 and MacOS. About time, hey :)
+set forking 1
+
+# [int] Backlog... ideal to see what happened to the bot on console.
+# maximum number of lines to backlog.
+set backlog 24
+
+#####
+# Miscellaneous...
+#####
+
+# [bool] Display a bit too much info about stuff.
+# 0 -- disable.
+# 1 -- minimal.
+# 2 -- some crap.
+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
+
+# debugging...
+###set dumpvars 1
+###set dumpvarsAtExit 1
+# log to specific file or global log file.
+###set dumpvarsLogFile dumpvars.log
+
+# [0/1] allow 'use strict', makes bot unreliable.
+set useStrict 0
+
+#####
+# Extras
+#####
+
+# [str] anything which requires LWP + http proxy.
+###set httpProxy http://HOSTNAME:PORT/
+
+# [0/1] babelfish translator. jdf++. FIXME
+set babelfish false
+
+# [0/1] offer free factoid cookies
+set cookie true
+
+# [0/1] Countdown to specific dates
+set countdown true
+
+# [0/1] Debian file and package search.
+set debian false
+# [int] how often to update the debian table, in days.
+set debianRefreshInterval 1
+# [0/1] extra stuff...
+set debianExtra true
+
+# [0/1] Frontend to dict.org's wordnet.
+set dict false
+
+# [0/1] Freshmeat
+set freshmeat false
+# [int] how often to update the freshmeat table, in hours.
+set freshmeatRefreshInterval 24
+# [chans|all] 10items/hour, might be annoying.
+###set freshmeatAnnounce #debian-bots
+# [bool] if factoid does not exist, check freshmeat for it.
+set freshmeatForFactoid false
+
+# [0/1] insult server
+set insult false
+
+# [0/1] karma
+set karma true
+
+# [0/1] Frontend to kernel.org
+set kernel false
+###set kernelAnnounce #debian-bots
+
+# [0/1] LART.
+set lart true
+
+# [array] Channel limit adjuster. List of channels.
+###set limitcheck #debian-bots
+# [int] Interval (or more than), in minutes.
+set limitcheckInterval 10
+# [int] Adjust channel limit to 10 above total users in channel.
+set limitcheckPlus 10
+
+# [0/1] nickometer
+set nickometer true
+
+# [0/1] Frontend to the stock market.
+set quote false
+
+# [0/1] Display random text in the channel.
+set randomQuote true
+# [str] Channels.
+set randomQuoteChannels #debian-bots
+# [int] Interval (or more than), in minutes.
+set randomQuoteInterval 60
+
+# [0/1] Display random text in the channel.
+set randomFactoid true
+# [str] Channels.
+set randomFactoidChannels #debian-bots
+# [int] Interval (or more than), in minutes.
+set randomFactoidInterval 60
+
+# [0/1] Warn users about root.
+set rootWarn false
+# passive -- be polite plus stuff, compliant to OPN, heh.
+# aggressive -- ...
+set rootWarnMode passive
+
+# [0/1] Factoid search.
+set search false
+
+# [0/1] persistant "seen".
+set seen true
+# [0/1] seen statistics for online users like idle time, total message
+# count.
+set seenStats true
+# [int] if someone's been away for more than xx days, delete their info.
+# info.
+set seenMaxDays 30
+# [int] interval to flush cached seen info. in minutes.
+set seenFlushInterval 60
+
+# [0/1] slashdot headlines.
+set slashdot false
+###set slashdotAnnounce #debian-bots
+
+# [0/1] frontend to ispell.
+set spell false
+
+# [0/1] Advanced topic management.
+set topic true
+
+# [0/1] User Information Services.
+set userinfo true
+
+# [0/1] Uptime daemon
+set uptime true
+
+# [0/1] weather.com. FIXME
+set weather false
+
+# [0/1] Wingate checking and banning mechanism. FIXME.
+###set wingate false
+# [int] seconds. minimum time to check.
+set wingateInterval 60
+# [str] Wingate.
+set wingateBan true
+# [str] Wingate.
+set wingateKick DIE DIE DIE
+
+# [0/1] google search.. simon++. requires libwww-search-perl + 5lines of
+# modifications.
+set wwwsearch false
+
+# [0/1] Unit conversion tool.
+set units true
--- /dev/null
+# 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
--- /dev/null
+hello => <REPLY> hi(, $who)?
+status => <REPLY> FIXME...
+rnd => <REPLY> $who: (0-10)
--- /dev/null
+#
+# Unit defintions
+# 10 March 1998 M-J. Dominus (mjd-perl-units-id-iut+buobvyy+@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@pobox.com, so that I can
+# include them in a future version. Please include the date of this
+# file, 3 March 1996, with all such submissions.
+
+# If a unit is defined as `***', that means
+# it has no definition because it is a fundamental unit.
+
+# Fundamental units:
+# Seven instrinsic SI units:
+gram ***
+metre ***
+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 metre
+km kilometre
+cm centimetre
+mm millimetre
+micron micrometre
+inch 2.54 cm # This is the official definition and is exact
+in inch
+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'
+parsec 1.91615e13 mi
+# 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 centimetre
+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 centimetre)2 # Particle physics
+board 144 in3/ft # Implies `board feet'
+
+# VOLUME
+cc cm3
+litre (decimetre)3
+ml millilitre
+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
+
+# 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 litres
+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
+short 100|112 # Convert long tons, cwts, and quarters to short.
+shortton short ton
+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
+### TODO: allow addition aswell.
+#celsius Celsius
+#C Celsius
+#Celsius K+273.1
+#farenheit Farenheit
+#F Farenheit
+
+# 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 metre 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
+Nm newton-metre
+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
+hPa hectopascal
+atmosphere 1.01325 N/m2 # NIST 1990301 EXACT
+atm atmosphere
+bar megadyne/cm2 # Implies `millibars'
+psi pound/inch/sec2
+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-metre
+joule Joule
+J joule
+kJ kilojoule
+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
+kW kiloWatt
+MW megaWatt
+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
+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
+crown 5 shillings # Implies `half crown'
+guinea 21 shillings
+florin 2 shillings
+
+
+# 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
--- /dev/null
+#!/usr/bin/perl
+
+# infobot -- copyright kevin lenzo (c) 1997-infinity
+# no warrantee expressed or implied. terms as the
+# license for X11R6 when needed.
+
+use strict;
+use vars qw($infobot_base_dir $infobot_src_dir $infobot_misc_dir
+ $infobot_pid $memusage %param
+);
+
+BEGIN {
+ # set this to the absolute path if you need it; especially
+ # if . is not in your path
+
+ $infobot_base_dir = '.';
+ $infobot_src_dir = "$infobot_base_dir/src";
+ $infobot_misc_dir = "$infobot_base_dir/files";
+ $infobot_pid = $$;
+
+ require "$infobot_src_dir/logger.pl";
+ require "$infobot_src_dir/core.pl";
+ require "$infobot_src_dir/interface.pl";
+ require "$infobot_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 = <PIDFILE> || "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;
--- /dev/null
+09:04.28 Loading ignore list...
+09:04.28 dpkg!*@*.com
+09:04.28 *!*@*.il
+09:04.28 apt!*@*
+09:04.28 Loaded ignore infobot.ignore (3 masks)
+09:04.28 Loaded lang infobot.lang (59 items)
+09:04.28 Loaded ircServers ircII.servers (2 servers)
+09:04.28 Loaded userlist infobot.users (2 users)
+09:04.28 GmLB:
+09:04.28 flags: +mrsteon
+09:04.28 default:
+09:04.28 flags: +mrt
+09:04.28 Created shared memory (shm) key: [347044]
+09:04.28 !WARN! PERL: DBI->connect failed: Access denied for user: 'blootbot@localhost' (Using password: YES) at ./src/db_mysql.pl line 14
+09:04.28 !ERROR! cannot connect to localhost.
+09:04.28 !WARN! closeDB: connection already closed?
+09:04.28 Closed shared memory (shm) key: [347044]
+09:05.30 Loading ignore list...
+09:05.30 dpkg!*@*.com
+09:05.30 *!*@*.il
+09:05.30 apt!*@*
+09:05.30 Loaded ignore infobot.ignore (3 masks)
+09:05.30 Loaded lang infobot.lang (59 items)
+09:05.30 Loaded ircServers ircII.servers (2 servers)
+09:05.30 Loaded userlist infobot.users (2 users)
+09:05.30 GmLB:
+09:05.30 flags: +mrsteon
+09:05.30 default:
+09:05.30 flags: +mrt
+09:05.30 Created shared memory (shm) key: [347428]
+09:05.31 Opened MySQL connection to localhost
+09:05.31 Setup: 9969 factoids.
+09:05.31 Initial memory usage: 7380 kB
+09:05.31 !DEBUG! ircloop: _ => 'irc.linux.com'.
+09:05.31 Connecting to port 6667 of server irc.linux.com ...
+09:05.34 resolved to 198.186.203.64.
+09:05.34 !DEBUG! clearIRCVars() called!
+09:05.34 There are 636 victims and 641 hiding on 26 servers
+09:05.34 14 operator(s) online
+09:05.34 414 channels formed
+09:05.34 I have 208 clients and 5 servers
+09:05.34 -irc.linux.com- Highest connection count: 265 (256 clients)
+09:05.34 !DEBUG! on_EOM: calling sS in 60s.
+09:05.34 Changing user modes to +iw.
+09:05.34 End of motd. Now lets join some channels...
+09:05.34 joining #debian-bots
+09:05.34 joinNextChan: 1 chans to join.
+09:05.34 -irc.linux.com- Welcome to Open Projects! You are on 2 ca 1(2) ft 14(14) tr.
+09:05.34 >>> mode [+f] by InfoCup
+09:05.35 >>> mode [+iw] by InfoCup
+09:05.35 >>> join/#debian-bots InfoCup (root@d239-76.hcvlny.optonline.net)
+09:05.35 #debian-bots: sync in 0.000s.
+09:05.35 #debian-bots: [3 total]
+09:05.35 joining #odd
+09:05.39 >>> join/#odd InfoCup (root@d239-76.hcvlny.optonline.net)
+09:05.39 #odd: sync in 0.000s.
+09:05.39 #odd: [1 ops || 1 total]
+09:05.39 ChanServ: <== 'Welcome to Optical Delusion Design, or as we know it ODD. Please have fun and enjoy your stay.'.
+09:06.08 >>> CTCP VERSION request from GmLB
+09:06.34 Writing uptime file for first time usage (nothing special).
+09:06.34 !ERROR! limitcheck: dont have ops on #debian-bots.
+09:06.34 FORK(684) fork starting for 'slashdot', PID == 684.
+09:06.34 FORK(685) fork starting for 'kernel', PID == 685.
+09:06.34 FORK(684) !DEBUG! lMM: setting moduleAge{./src/Modules/Slashdot3.pl} = time();
+09:06.34 FORK(684) myModule: Loaded Slashdot3.pl ...
+09:06.34 FORK(684) MEM: (Slashdot3.pl) increased by 712 kB. (total: 8092 kB)
+09:06.34 FORK(684) !DEBUG! sdA: mking dir.
+09:06.34 FORK(685) !DEBUG! lMM: setting moduleAge{./src/Modules/Kernel.pl} = time();
+09:06.34 FORK(685) myModule: Loaded Kernel.pl ...
+09:06.34 FORK(685) MEM: (Kernel.pl) increased by 740 kB. (total: 8120 kB)
+09:06.35 FORK(684) Module: Loaded LWP::UserAgent ...
+09:06.35 FORK(684) MEM: (LWP::UserAgent) increased by 932 kB. (total: 9024 kB)
+09:06.35 FORK(684) getURL: getting 'http://www.slashdot.org/slashdot.xml'
+09:06.38 FORK(685) fork: took 4s for kernel.
+09:06.38 FORK(685) fork finished for 'kernel'.
+09:06.54 MEM: increased by 692 kB. (total: 8072 kB)
+09:06.54 gmlb is addressing me
+09:06.54 <GmLB/#debian-bots> InfoCup: kernel?
+09:06.54 shm: Processing 'DELETE FORK kernel'.
+09:06.54 !WARN! PERL: Use of uninitialized value at ./src/CommandStubs.pl line 36.
+09:06.54 !DEBUG! Question: hrm... result => ''.
+09:06.54 notfound: <gmlb> kernel
+09:06.54 !DEBUG! lMM: setting moduleAge{./src/Modules/Math.pl} = time();
+09:06.54 myModule: Loaded Math.pl ...
+09:06.54 MEM: (Math.pl) increased by 52 kB.
+09:06.54 unparseable: kernel?
+09:06.54 </#debian-bots> GmLB: I give up, what is it?
+09:06.59 gmlb is addressing me
+09:06.59 <GmLB/#debian-bots> InfoCup: Who are you
+09:07.00 !DEBUG! Question: hrm... result => ''.
+09:07.00 notfound: <gmlb> Who are you :: InfoCup
+09:07.00 IGNORE statement: <gmlb> Who are you
+09:07.00 </#debian-bots> what are you talking about?, GmLB
+09:07.02 MEM: increased by 16 kB.
+09:07.02 gmlb is addressing me
+09:07.02 <GmLB/#debian-bots> InfoCup: rape
+09:07.02 !DEBUG! isFlag: userHandle == 'default'.
+09:07.02 question: <gmlb> rape
+09:07.02 </#debian-bots> rape is probably vt. 1. To screw someone or something, violently; in particular, to destroy a program or information irrecoverably. Often used in describing file-system damage. "So-and-so was running a program that did absolute disk I/O and ended up raping the master directory." 2. To strip a piece of hardware for parts.
+09:07.24 gmlb is addressing me
+09:07.24 [GmLB] help
+09:07.24 >gmlb< 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?"
+09:07.24 >gmlb< 37 topics: action, addressing, alternation, author, babelfish, chaninfo, cookie, corrections, crypt, dict, dollar variables, factinfo, factstats, find, forget, freshmeat, insult, join, karma, kernel, kick, lart, listauth, listkeys, listvalues, lobotomy, lock, main, maths, nickometer, nslookup, part, quote, rename, reply, rot13, search
+09:07.24 >gmlb< 13 topics: seen, slashdot, spell, topic, topic add, topic del, topic mod, topic mv, topic restore, unlobotomy, unlock, wantnick, weather
+09:12.09 MEM: increased by 16 kB.
+09:12.09 gmlb is addressing me
+09:12.09 [GmLB] babelfish
+09:12.09 !DEBUG! Question: hrm... result => ''.
+09:12.09 unparseable: babelfish
+09:12.09 >gmlb< no idea
+09:12.13 MEM: increased by 16 kB.
+09:12.13 gmlb is addressing me
+09:12.13 [GmLB] help babelfish
+09:12.13 >gmlb< Desc: Frontend to babelfish translating service provided by digital.com
+09:12.13 >gmlb< Usage: x to <lang>: <words>
+09:12.13 >gmlb< Usage: translate from <lang>: <words>
+09:12.13 >gmlb< Example: x to de: your cars rock
+09:12.22 gmlb is addressing me
+09:12.22 [GmLB] fish to french
+09:12.22 !DEBUG! Question: hrm... result => ''.
+09:12.22 unparseable: fish to french
+09:12.22 >gmlb< wish i knew, GmLB
+09:12.46 gmlb is addressing me
+09:12.46 [GmLB] x to de: You car rock
+09:12.46 !WARN! Fork: looks like we lost 'slashdot', executed 372 ago.
+09:12.46 FORK(691) fork starting for 'babelfish', PID == 691.
+09:12.46 FORK(691) !WARN! loadMyModule: module is NULL.
+09:12.46 FORK(691) !DEBUG! Forker: failed?
+09:12.57 gmlb is addressing me
+09:12.57 [GmLB] x to de: You car rock
+09:12.57 >gmlb< babelfish is already running 11s
+09:13.18 FORK(691) gmlb is addressing me
+09:13.18 FORK(691) [GmLB] google for chickens
+09:13.18 FORK(691) double fork detected; not forking.
+09:13.18 FORK(691) !DEBUG! lMM: setting moduleAge{./src/Modules/W3Search.pl} = time();
+09:13.18 FORK(691) myModule: Loaded W3Search.pl ...
+09:13.19 FORK(691) Module: Loaded WWW::Search ...
+09:13.19 FORK(691) MEM: (WWW::Search) increased by 1160 kB. (total: 9332 kB)
+09:13.20 FORK(691) >gmlb< Google says chickens is at http://usda.mannlib.cornell.edu/reports/nassr/poultry/pec-bb/ or http://vfih.editthispage.com/stories/storyReader$11 or http://www.apbnews.com/safetycenter/injury/2000/05/19/chickens0519_01.html
+09:13.29 gmlb is addressing me
+09:13.29 [GmLB] google for humphrey
+09:13.29 FORK(692) fork starting for 'wwwsearch', PID == 692.
+09:13.29 FORK(692) !DEBUG! lMM: setting moduleAge{./src/Modules/W3Search.pl} = time();
+09:13.29 FORK(692) myModule: Loaded W3Search.pl ...
+09:13.29 FORK(692) Module: Loaded WWW::Search ...
+09:13.29 FORK(692) MEM: (WWW::Search) increased by 1160 kB. (total: 9332 kB)
+09:13.30 FORK(692) >gmlb< Google says humphrey is at http://www.hhh.umn.edu/welcome.html or http://www.humphrey.com/ or http://www.humphrey.com/Company/company.html
+09:13.30 FORK(692) fork: took 1s for wwwsearch.
+09:13.30 FORK(692) fork finished for 'wwwsearch'.
+09:13.37 FORK(691) MEM: increased by 732 kB. (total: 10064 kB)
+09:13.37 FORK(691) gmlb is addressing me
+09:13.37 FORK(691) [GmLB] google for zchicken
+09:13.37 FORK(691) shm: Processing 'DELETE FORK wwwsearch'.
+09:13.37 FORK(691) double fork detected; not forking.
+09:13.39 FORK(691) >gmlb< Google says zchicken is at http://ywmm.zchicken.com/Zchicken_main.html or http://www.guestbook4free.com/en/18018/entries/ or http://download.cnet.com/downloads/0-10060-107-916322.html
+09:14.46 FORK(691) gmlb is addressing me
+09:14.46 FORK(691) [GmLB] stock
+09:14.47 FORK(691) !DEBUG! Question: hrm... result => ''.
+09:14.47 FORK(691) unparseable: stock
+09:14.47 FORK(691) >gmlb< wish i knew, GmLB
+09:14.49 gmlb is addressing me
+09:14.49 [GmLB] help stock
+09:14.49 >gmlb< no help on stock. Use 'help' without arguments.
+09:14.51 FORK(691) gmlb is addressing me
+09:14.51 FORK(691) [GmLB] help stocks
+09:14.51 FORK(691) >gmlb< no help on stocks. Use 'help' without arguments.
+09:14.55 gmlb is addressing me
+09:14.55 [GmLB] help lookup
+09:14.55 >gmlb< no help on lookup. Use 'help' without arguments.
+09:14.56 FORK(691) gmlb is addressing me
+09:14.56 FORK(691) [GmLB] help
+09:14.56 FORK(691) >gmlb< 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?"
+09:14.56 FORK(691) >gmlb< 37 topics: action, addressing, alternation, author, babelfish, chaninfo, cookie, corrections, crypt, dict, dollar variables, factinfo, factstats, find, forget, freshmeat, insult, join, karma, kernel, kick, lart, listauth, listkeys, listvalues, lobotomy, lock, main, maths, nickometer, nslookup, part, quote, rename, reply, rot13, search
+09:14.56 FORK(691) >gmlb< 13 topics: seen, slashdot, spell, topic, topic add, topic del, topic mod, topic mv, topic restore, unlobotomy, unlock, wantnick, weather
+09:15.01 gmlb is addressing me
+09:15.01 [GmLB] slashdot
+09:15.01 FORK(732) fork starting for 'slashdot', PID == 732.
+09:15.01 FORK(732) !DEBUG! lMM: setting moduleAge{./src/Modules/Slashdot3.pl} = time();
+09:15.01 FORK(732) myModule: Loaded Slashdot3.pl ...
+09:15.02 FORK(732) Module: Loaded LWP::UserAgent ...
+09:15.02 FORK(732) MEM: (LWP::UserAgent) increased by 928 kB. (total: 9100 kB)
+09:15.02 FORK(732) getURL: getting 'http://www.slashdot.org/slashdot.xml'
+09:15.02 FORK(732) >gmlb< Slashdot Headlines (7 shown; 10 total): Two-Faced Napster? ;; Inside Echelon ;; SETI Accelerator Hoax Revealed ;; MPAA v. 2600 NY Trial Has Ended ;; IBM Does Bluetooth On Linux ;; Kuro5hin Forced Down By DOS ;; 30+ GB Databases On Unix?.
+09:15.02 FORK(732) fork: took 1s for slashdot.
+09:15.02 FORK(732) fork finished for 'slashdot'.
+09:15.14 FORK(691) gmlb is addressing me
+09:15.14 FORK(691) [GmLB] topic
+09:15.14 FORK(691) shm: Processing 'DELETE FORK slashdot'.
+09:15.14 FORK(691) !WARN! PERL: Use of uninitialized value at ./src/CommandStubs.pl line 486.
+09:15.14 FORK(691) >gmlb< Try 'help topic'
+09:15.17 FORK(691) gmlb is addressing me
+09:15.17 FORK(691) [GmLB] help topic
+09:15.17 FORK(691) >gmlb< Usage for 'topic [#chan] <params>':
+09:15.17 FORK(691) >gmlb< ---------------- Subtopic:
+09:15.17 FORK(691) >gmlb< add <TOPIC> - Append <TOPIC> to topic.
+09:15.17 FORK(691) >gmlb< del <#> - Remove subtopic <#> from topic.
+09:15.17 FORK(691) >gmlb< list - Display subtopics.
+09:15.17 FORK(691) >gmlb< mod s/old/new/ - Search and replace topic.
+09:15.17 FORK(691) >gmlb< mv <ARGS> - 'topic mv'.
+09:15.17 FORK(691) >gmlb< shuffle - Randomly organize subtopics.
+09:15.17 FORK(691) >gmlb< ---------------- Topic
+09:15.17 FORK(691) >gmlb< history - Show previous topics.
+09:15.17 FORK(691) >gmlb< restore <#> - Restore topic to <#>.
+09:15.17 FORK(691) >gmlb< rehash - Rehash changes to topic.
+09:15.17 FORK(691) >gmlb< info - Who and time info.
+09:15.17 FORK(691) >gmlb< ---------------- Misc
+09:15.17 FORK(691) >gmlb< about - Read the file :)
+09:15.17 FORK(691) >gmlb< help - This screen.
+09:15.17 FORK(691) >gmlb< 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.
+09:15.17 FORK(691) >gmlb< NOTE: commands can be preceeded? with '-' in order not to enforce changes to topic.
+09:15.17 FORK(691) >gmlb< End of help.
+09:15.24 gmlb is addressing me
+09:15.24 [GmLB] weather
+09:15.24 !DEBUG! Question: hrm... result => ''.
+09:15.24 unparseable: weather
+09:15.24 >gmlb< I'm not sure, is it larger than a breadbox?
+09:17.44 FORK(684) !DEBUG! sdA: failure (Cxml == NULL).
+09:17.44 FORK(684) fork: took 11m 10s for slashdot.
+09:17.44 FORK(684) fork finished for 'slashdot'.
+09:21.34 shm: Processing 'DELETE FORK slashdot'.
+09:35.34 !ERROR! limitcheck: dont have ops on #debian-bots.
+09:35.34 FORK(691) !ERROR! limitcheck: dont have ops on #debian-bots.
+10:01.34 !ERROR! limitcheck: dont have ops on #debian-bots.
+10:05.34 FORK(691) !ERROR! limitcheck: dont have ops on #debian-bots.
+10:10.34 FORK(691) double fork detected; not forking.
+10:10.34 FORK(691) !DEBUG! lMM: setting moduleAge{./src/Modules/Slashdot3.pl} = time();
+10:10.34 FORK(691) myModule: Loaded Slashdot3.pl ...
+10:10.34 FORK(691) Module: Loaded LWP::UserAgent ...
+10:10.34 FORK(691) getURL: getting 'http://www.slashdot.org/slashdot.xml'
+10:10.34 !WARN! Fork: looks like we lost 'babelfish', executed 3468 ago.
+10:10.34 !WARN! Fork: looks like we lost 'wwwsearch', executed 3425 ago.
+10:10.34 FORK(749) fork starting for 'slashdot', PID == 749.
+10:10.34 FORK(749) !DEBUG! lMM: setting moduleAge{./src/Modules/Slashdot3.pl} = time();
+10:10.34 FORK(749) myModule: Loaded Slashdot3.pl ...
+10:10.35 FORK(749) Module: Loaded LWP::UserAgent ...
+10:10.35 FORK(749) MEM: (LWP::UserAgent) increased by 928 kB. (total: 9100 kB)
+10:10.35 FORK(749) getURL: getting 'http://www.slashdot.org/slashdot.xml'
+10:10.36 FORK(749) getURL: Done (took 1s, 3 k/sec)
+10:10.36 FORK(749) Slashdot: no new headlines.
+10:10.36 FORK(749) fork: took 2s for slashdot.
+10:10.36 FORK(749) fork finished for 'slashdot'.
+10:11.34 FORK(691) shm: Processing 'DELETE FORK slashdot'.
+10:31.34 !ERROR! limitcheck: dont have ops on #debian-bots.
+10:35.34 FORK(691) !ERROR! limitcheck: dont have ops on #debian-bots.
+10:48.39 <GmLB/#debian-bots> slashdot
+10:48.44 FORK(691) gmlb is addressing me
+10:48.44 FORK(691) <GmLB/#debian-bots> InfoCup: slashdot
+10:48.44 FORK(691) double fork detected; not forking.
+10:48.44 FORK(691) getURL: getting 'http://www.slashdot.org/slashdot.xml'
+10:48.44 FORK(691) </#debian-bots> Slashdot Headlines (7 shown; 10 total): GTK-Themes To Be Supported By KDE2 ;; G4 Powerbooks Predicted For January 2001 ;; Two-Faced Napster? ;; Inside Echelon ;; SETI Accelerator Hoax Revealed ;; MPAA v. 2600 NY Trial Has Ended ;; IBM Does Bluetooth On Linux.
+11:04.34 !ERROR! limitcheck: dont have ops on #debian-bots.
+11:05.18 FORK(691) gmlb is addressing me
+11:05.18 FORK(691) [GmLB] fuck
+11:05.18 FORK(691) !DEBUG! Question: hrm... result => ''.
+11:05.18 FORK(691) unparseable: fuck
+11:05.18 FORK(691) >gmlb< i haven't a clue
+11:05.20 gmlb is addressing me
+11:05.20 [GmLB] rape
+11:05.20 !DEBUG! isFlag: userHandle == 'default'.
+11:05.20 question: <gmlb> rape
+11:05.20 >gmlb< somebody said rape was vt. 1. To screw someone or something, violently; in particular, to destroy a program or information irrecoverably. Often used in describing file-system damage. "So-and-so was running a program that did absolute disk I/O and ended up raping the master directory." 2. To strip a piece of hardware for parts.
+11:05.23 FORK(691) gmlb is addressing me
+11:05.23 FORK(691) [GmLB] shit
+11:05.23 FORK(691) !DEBUG! Question: hrm... result => ''.
+11:05.23 FORK(691) unparseable: shit
+11:05.23 FORK(691) >gmlb< bugger all, i dunno
+11:05.24 gmlb is addressing me
+11:05.24 [GmLB] sex
+11:05.25 !DEBUG! isFlag: userHandle == 'default'.
+11:05.25 question: <gmlb> sex
+11:05.25 >gmlb< [sex] /seks/ [Sun Users' Group & elsewhere] n. 1. Software EXchange. A technique invented by the blue-green algae hundreds of millions of years ago to speed up their evolution, which had been terribly slow up until then. Today, SEX parties are popular among hackers and others (of course, these are no longer limited to exchanges of genetic software). In general, SEX parties are a {Good Thing}, but unprotected SEX can propagate a virus. See also {pubic directory}. 2. The rather Freudian mnemonic often used for Sign EXtend, a machine instruction found in the PDP-11 and many other architectures. DEC's engineers nearly got a PDP-11 assembler that used the `SEX' mnemonic out the door at one time, but (for once) marketing wasn't asleep and forced a change. That wasn't the last time this happened, either. The author of `The Intel 8086 Primer', who was one of the original designers of the 8086, noted that there was originally a `SEX' instruction on that processor, too. He says that Intel management got cold feet and decreed that it be changed, and thus the instruction was renamed `CBW' and `CWD' (depending on what was being extended). Amusingly, the Intel 8048 (the microcontroller used in IBM PC keyboards) is also missing straight `SEX' but has logical-or and logical-and instructions `ORL' and `ANL'. The Motorola 6809, used in the U.K.'s `Dragon 32' personal computer, actually had an official `SEX' instruction; the 6502 in the Apple II it competed with did not. British hackers thought this made perfect mythic sense; after all, it was commonly observed, you could have sex with a dragon, but you can't have sex with an apple.
+11:06.34 FORK(691) gmlb is addressing me
+11:06.34 FORK(691) [GmLB] hackers
+11:06.34 FORK(691) !DEBUG! Question: hrm... result => ''.
+11:06.34 FORK(691) unparseable: hackers
+11:06.34 FORK(691) >gmlb< wish i knew
+11:06.36 MEM: increased by 12 kB.
+11:06.36 gmlb is addressing me
+11:06.36 [GmLB] hacker
+11:06.36 !DEBUG! isFlag: userHandle == 'default'.
+11:06.36 question: <gmlb> hacker
+11:06.36 >gmlb< hacker is, like, [originally, someone who makes furniture with an axe] n. 1. A person who enjoys exploring the details of programmable systems and how to stretch their capabilities, as opposed to most users, who prefer to learn only the minimum necessary. 2. One who programs enthusiastically (even obsessively) or who enjoys programming rather than just theorizing about programming. 3. A person capable of appreciating {hack value}. 4. A person who is good at programming quickly. 5. An expert at a particular program, or one who frequently does work using it or on it; as in `a UNIX hacker'. (Definitions 1 through 5 are correlated, and people who fit them congregate.) 6. An expert or enthusiast of any kind. One might be an astronomy hacker, for example. 7. One who enjoys the intellectual challenge of creatively overcoming or circumventing limitations. 8. [deprecated] A malicious meddler who tries to discover sensitive information by poking around. Hence `password hacker', `network hacker'. See cracker. It is better to be described as a hacker by others than to describe oneself that way. Hackers consider themselves something of an elite (a meritocracy based on ability), though one to which new members are gladly welcome. There is thus a certain ego satisfaction to be had in identifying yourself as a hacker (but if you claim to be one and are not, you'll quickly be labeled bogus).
+11:08.34 FORK(691) !ERROR! limitcheck: dont have ops on #debian-bots.
+11:10.34 !WARN! Fork: looks like we lost 'slashdot', executed 3600 ago.
+11:10.34 FORK(789) fork starting for 'slashdot', PID == 789.
+11:10.34 FORK(789) !DEBUG! lMM: setting moduleAge{./src/Modules/Slashdot3.pl} = time();
+11:10.34 FORK(789) myModule: Loaded Slashdot3.pl ...
+11:10.34 FORK(789) MEM: (Slashdot3.pl) increased by 16 kB.
+11:10.35 FORK(789) Module: Loaded LWP::UserAgent ...
+11:10.35 FORK(789) MEM: (LWP::UserAgent) increased by 932 kB. (total: 9132 kB)
+11:10.35 FORK(789) getURL: getting 'http://www.slashdot.org/slashdot.xml'
+11:10.35 FORK(789) sending slashdot update to #debian-bots.
+11:10.35 FORK(789) -#debian-bots- Slashdot: News for nerds, stuff that matters -- GTK-Themes To Be Supported By KDE2
+11:10.36 FORK(789) fork: took 2s for slashdot.
+11:10.36 FORK(789) fork finished for 'slashdot'.
+11:11.34 shm: Processing 'DELETE FORK slashdot'.
+11:13.18 >>> GmLB has signed off IRC ([x]chat)
+11:14.34 FORK(691) double fork detected; not forking.
+11:14.34 FORK(691) getURL: getting 'http://www.slashdot.org/slashdot.xml'
+11:25.43 FORK(691) !DEBUG! sdA: failure (Cxml == NULL).
+11:32.34 !ERROR! limitcheck: dont have ops on #debian-bots.
+11:37.34 FORK(691) !ERROR! limitcheck: dont have ops on #debian-bots.
+12:04.34 !ERROR! limitcheck: dont have ops on #debian-bots.
+12:07.34 FORK(691) !ERROR! limitcheck: dont have ops on #debian-bots.
+12:10.34 FORK(806) fork starting for 'slashdot', PID == 806.
+12:10.35 FORK(806) !DEBUG! lMM: setting moduleAge{./src/Modules/Slashdot3.pl} = time();
+12:10.35 FORK(806) myModule: Loaded Slashdot3.pl ...
+12:10.35 FORK(806) MEM: (Slashdot3.pl) increased by 20 kB.
+12:10.35 FORK(806) Module: Loaded LWP::UserAgent ...
+12:10.35 FORK(806) MEM: (LWP::UserAgent) increased by 928 kB. (total: 9132 kB)
+12:10.35 FORK(806) getURL: getting 'http://www.slashdot.org/slashdot.xml'
+12:10.36 FORK(806) Slashdot: no new headlines.
+12:10.36 FORK(806) fork: took 2s for slashdot.
+12:10.36 FORK(806) fork finished for 'slashdot'.
+12:10.44 FORK(691) shm: Processing 'DELETE FORK slashdot'.
+12:26.43 FORK(691) double fork detected; not forking.
+12:26.43 FORK(691) getURL: getting 'http://www.slashdot.org/slashdot.xml'
+12:26.43 FORK(691) Slashdot: no new headlines.
+12:27.09 >>> apt has signed off IRC (Ping timeout for apt[achilles.nyip.net])
+12:27.14 >>> join/#debian-bots apt (apt@achilles.nyip.net)
+12:30.34 !ERROR! limitcheck: dont have ops on #debian-bots.
+12:36.34 FORK(691) !ERROR! limitcheck: dont have ops on #debian-bots.
+12:53.08 disconnect from irc.linux.com (Connection reset by peer).
+12:53.08 FORK(691) disconnect from irc.linux.com (ERROR :Closing Link: InfoCup[d239-76.hcvlny.optonline.net] by irc.linux.com (Ping timeout for InfoCup[d239-76.hcvlny.optonline.net])).
+12:53.08 !DEBUG! clearIRCVars() called!
+12:53.08 FORK(691) !DEBUG! clearIRCVars() called!
+12:53.08 disconnect from irc.linux.com (ERROR :Closing Link: InfoCup[24.189.239.76] by irc.linux.com (Overridden by other sign on)).
+12:53.08 !DEBUG! clearIRCVars() called!
+12:53.09 FORK(691) disconnect from irc.linux.com (ERROR :Closing Link: InfoCup[24.189.239.76] by irc.linux.com (Overridden by other sign on)).
+12:53.09 FORK(691) !DEBUG! clearIRCVars() called!
+12:53.09 There are 626 victims and 648 hiding on 26 servers
+12:53.09 14 operator(s) online
+12:53.09 1 unknown connection(s)
+12:53.09 437 channels formed
+12:53.09 I have 172 clients and 6 servers
+12:53.09 -irc.linux.com- Highest connection count: 265 (256 clients)
+12:53.09 Changing user modes to +iw.
+12:53.09 FORK(691) !DEBUG! on_nick_taken: changing nick to InfoCup8.
+12:53.09 End of motd. Now lets join some channels...
+12:53.09 joining #debian-bots
+12:53.09 joinNextChan: 1 chans to join.
+12:53.09 -irc.linux.com- Welcome to Open Projects! You are on 1 ca 1(2) ft 14(14) tr.
+12:53.09 >>> mode [+f] by InfoCup
+12:53.09 >>> mode [+iw] by InfoCup
+12:53.09 >>> join/#debian-bots InfoCup (root@d239-76.hcvlny.optonline.net)
+12:53.09 #debian-bots: sync in 0.000s.
+12:53.09 #debian-bots: [2 total]
+12:53.09 joining #odd
+12:53.09 FORK(691) There are 626 victims and 649 hiding on 26 servers
+12:53.09 FORK(691) 14 operator(s) online
+12:53.09 FORK(691) 1 unknown connection(s)
+12:53.09 FORK(691) 437 channels formed
+12:53.09 FORK(691) I have 173 clients and 6 servers
+12:53.09 FORK(691) -irc.linux.com- Highest connection count: 265 (256 clients)
+12:53.09 FORK(691) Changing user modes to +iw.
+12:53.09 FORK(691) End of motd. Now lets join some channels...
+12:53.09 FORK(691) joining #debian-bots
+12:53.09 FORK(691) joinNextChan: 1 chans to join.
+12:53.09 FORK(691) -irc.linux.com- Welcome to Open Projects! You are on 2 ca 2(2) ft 14(14) tr.
+12:53.09 FORK(691) >>> mode [+f] by InfoCup8
+12:53.09 FORK(691) >>> mode [+iw] by InfoCup8
+12:53.09 FORK(691) >>> join/#debian-bots InfoCup8 (root@d239-76.hcvlny.optonline.net)
+12:53.10 FORK(691) #debian-bots: sync in 0.000s.
+12:53.10 FORK(691) #debian-bots: [3 total]
+12:53.10 FORK(691) joining #odd
+12:53.10 >>> join/#debian-bots InfoCup8 (root@d239-76.hcvlny.optonline.net)
+12:53.13 >>> join/#odd InfoCup (root@d239-76.hcvlny.optonline.net)
+12:53.13 #odd: sync in 0.000s.
+12:53.13 #odd: [1 ops || 1 total]
+12:53.13 ChanServ: <== 'Welcome to Optical Delusion Design, or as we know it ODD. Please have fun and enjoy your stay.'.
+12:53.15 >>> join/#odd InfoCup8 (root@d239-76.hcvlny.optonline.net)
+12:53.15 FORK(691) >>> join/#odd InfoCup8 (root@d239-76.hcvlny.optonline.net)
+12:53.15 FORK(691) #odd: sync in 0.000s.
+12:53.15 FORK(691) #odd: [1 ops || 2 total]
+12:53.15 FORK(691) ChanServ: <== 'Welcome to Optical Delusion Design, or as we know it ODD. Please have fun and enjoy your stay.'.
+13:04.34 !ERROR! limitcheck: dont have ops on #debian-bots.
+13:05.34 FORK(691) !WARN! PERL: Use of uninitialized value at ./src/IRC/Schedulers.pl line 367.
+13:05.34 FORK(691) !WARN! ircCheck: ident(InfoCup8) != param{ircNick}().
+13:06.34 FORK(691) !ERROR! limitcheck: dont have ops on #debian-bots.
+13:09.34 !WARN! Fork: looks like we lost 'slashdot', executed 3540 ago.
+13:09.34 FORK(825) fork starting for 'kernel', PID == 825.
+13:09.34 FORK(691) double fork detected; not forking.
+13:09.34 FORK(691) !DEBUG! lMM: setting moduleAge{./src/Modules/Kernel.pl} = time();
+13:09.34 FORK(691) myModule: Loaded Kernel.pl ...
+13:09.34 FORK(825) !DEBUG! lMM: setting moduleAge{./src/Modules/Kernel.pl} = time();
+13:09.34 FORK(825) myModule: Loaded Kernel.pl ...
+13:09.34 FORK(825) MEM: (Kernel.pl) increased by 48 kB.
+13:09.35 FORK(825) !DEBUG! kA: no new kernels.
+13:09.35 FORK(825) fork: took 1s for kernel.
+13:09.35 FORK(825) fork finished for 'kernel'.
+13:09.36 FORK(691) !DEBUG! kA: no new kernels.
+13:10.34 shm: Processing 'DELETE FORK kernel'.
+13:10.34 FORK(827) fork starting for 'slashdot', PID == 827.
+13:10.35 FORK(827) !DEBUG! lMM: setting moduleAge{./src/Modules/Slashdot3.pl} = time();
+13:10.35 FORK(827) myModule: Loaded Slashdot3.pl ...
+13:10.35 FORK(827) MEM: (Slashdot3.pl) increased by 20 kB.
+13:10.35 FORK(827) Module: Loaded LWP::UserAgent ...
+13:10.35 FORK(827) MEM: (LWP::UserAgent) increased by 932 kB. (total: 9136 kB)
+13:10.35 FORK(827) getURL: getting 'http://www.slashdot.org/slashdot.xml'
+13:10.36 FORK(827) getURL: Done (took 1s, 3 k/sec)
+13:10.36 FORK(827) sending slashdot update to #debian-bots.
+13:10.36 FORK(827) -#debian-bots- Slashdot: News for nerds, stuff that matters -- Kuro5hin - Bitter and Hopeful
+13:10.36 FORK(691) -InfoCup/#debian-bots- Slashdot: News for nerds, stuff that matters -- Kuro5hin - Bitter and Hopeful
+13:10.37 FORK(827) fork: took 3s for slashdot.
+13:10.37 FORK(827) fork finished for 'slashdot'.
+13:10.44 FORK(691) shm: Processing 'DELETE FORK slashdot'.
+13:26.43 FORK(691) double fork detected; not forking.
+13:26.43 FORK(691) getURL: getting 'http://www.slashdot.org/slashdot.xml'
+13:29.23 FORK(691) !DEBUG! sdA: failure (Cxml == NULL).
+13:34.34 !ERROR! limitcheck: dont have ops on #debian-bots.
+13:34.34 FORK(691) !ERROR! limitcheck: dont have ops on #debian-bots.
+14:05.34 FORK(691) !ERROR! limitcheck: dont have ops on #debian-bots.
+14:08.34 !ERROR! limitcheck: dont have ops on #debian-bots.
+14:10.34 !WARN! Fork: looks like we lost 'slashdot', executed 3600 ago.
+14:10.34 FORK(842) fork starting for 'slashdot', PID == 842.
+14:10.34 FORK(842) !DEBUG! lMM: setting moduleAge{./src/Modules/Slashdot3.pl} = time();
+14:10.34 FORK(842) myModule: Loaded Slashdot3.pl ...
+14:10.34 FORK(842) MEM: (Slashdot3.pl) increased by 20 kB.
+14:10.35 FORK(842) Module: Loaded LWP::UserAgent ...
+14:10.35 FORK(842) MEM: (LWP::UserAgent) increased by 932 kB. (total: 9136 kB)
+14:10.35 FORK(842) getURL: getting 'http://www.slashdot.org/slashdot.xml'
+14:13.15 FORK(842) !DEBUG! sdA: failure (Cxml == NULL).
+14:13.15 FORK(842) fork: took 2m 41s for slashdot.
+14:13.15 FORK(842) fork finished for 'slashdot'.
+14:15.44 FORK(691) shm: Processing 'DELETE FORK slashdot'.
+14:28.23 FORK(691) double fork detected; not forking.
+14:28.23 FORK(691) getURL: getting 'http://www.slashdot.org/slashdot.xml'
+14:30.08 FORK(691) getURL: Done (took 1m 45s, 0 k/sec)
+14:30.08 FORK(691) Slashdot: no new headlines.
+14:35.05 FORK(691) child caught SIGINT (pid 691).
+14:35.05 parent caught SIGINT (pid 679).
+14:35.05 QUIT InfoCup has quit IRC (BEE RICHT BAK)
+14:35.05 Closed MySQL connection to localhost.
+14:35.05 Closed shared memory (shm) key: [347428]
+14:35.09 Loading ignore list...
+14:35.09 dpkg!*@*.com
+14:35.09 *!*@*.il
+14:35.09 apt!*@*
+14:35.09 Loaded ignore infobot.ignore (3 masks)
+14:35.09 Loaded lang infobot.lang (59 items)
+14:35.09 Loaded ircServers ircII.servers (2 servers)
+14:35.09 Loaded userlist infobot.users (2 users)
+14:35.09 GmLB:
+14:35.09 flags: +mrsteon
+14:35.09 default:
+14:35.09 flags: +mrt
+14:35.09 Created shared memory (shm) key: [718854]
+14:35.10 Opened MySQL connection to localhost
+14:35.11 Setup: 9969 factoids.
+14:35.11 Initial memory usage: 7380 kB
+14:35.11 !DEBUG! ircloop: _ => 'irc.linux.com'.
+14:35.11 Connecting to port 6667 of server irc.linux.com ...
+14:35.14 resolved to 198.186.203.64.
+14:35.14 !DEBUG! clearIRCVars() called!
+14:35.15 There are 613 victims and 637 hiding on 26 servers
+14:35.15 17 operator(s) online
+14:35.15 440 channels formed
+14:35.15 I have 204 clients and 6 servers
+14:35.15 -irc.linux.com- Highest connection count: 265 (256 clients)
+14:35.15 !DEBUG! on_EOM: calling sS in 60s.
+14:35.15 Changing user modes to +iw.
+14:35.15 End of motd. Now lets join some channels...
+14:35.15 joining #debian-bots
+14:35.15 joinNextChan: 1 chans to join.
+14:35.15 -irc.linux.com- Welcome to Open Projects! You are on 1 ca 1(2) ft 14(14) tr.
+14:35.15 >>> mode [+f] by InfoCup
+14:35.15 >>> mode [+iw] by InfoCup
+14:35.15 >>> join/#debian-bots InfoCup (root@d239-76.hcvlny.optonline.net)
+14:35.15 #debian-bots: sync in 0.000s.
+14:35.15 #debian-bots: [2 total]
+14:35.15 joining #odd
+14:35.19 >>> join/#odd InfoCup (root@d239-76.hcvlny.optonline.net)
+14:35.19 #odd: sync in 0.000s.
+14:35.19 #odd: [1 ops || 1 total]
+14:35.19 ChanServ: <== 'Welcome to Optical Delusion Design, or as we know it ODD. Please have fun and enjoy your stay.'.
+14:35.42 >>> join/#odd GmLB (danny@d239-76.hcvlny.optonline.net)
+14:35.42 >>> mode/#odd [+o GmLB] by ChanServ
+14:36.15 !ERROR! limitcheck: dont have ops on #debian-bots.
+14:36.16 FORK(875) fork starting for 'slashdot', PID == 875.
+14:36.16 FORK(875) !DEBUG! lMM: setting moduleAge{./src/Modules/Slashdot3.pl} = time();
+14:36.16 FORK(875) myModule: Loaded Slashdot3.pl ...
+14:36.16 FORK(875) MEM: (Slashdot3.pl) increased by 712 kB. (total: 8092 kB)
+14:36.16 FORK(876) fork starting for 'kernel', PID == 876.
+14:36.16 FORK(876) !DEBUG! lMM: setting moduleAge{./src/Modules/Kernel.pl} = time();
+14:36.16 FORK(876) myModule: Loaded Kernel.pl ...
+14:36.16 FORK(876) MEM: (Kernel.pl) increased by 740 kB. (total: 8120 kB)
+14:36.16 FORK(875) Module: Loaded LWP::UserAgent ...
+14:36.16 FORK(875) MEM: (LWP::UserAgent) increased by 932 kB. (total: 9024 kB)
+14:36.16 FORK(875) getURL: getting 'http://www.slashdot.org/slashdot.xml'
+14:36.16 FORK(875) Slashdot: no new headlines.
+14:36.16 FORK(875) fork: took 0s for slashdot.
+14:36.16 FORK(875) fork finished for 'slashdot'.
+14:36.17 FORK(876) !DEBUG! kA: no new kernels.
+14:36.17 FORK(876) fork: took 1s for kernel.
+14:36.17 FORK(876) fork finished for 'kernel'.
+14:41.16 shm: Processing 'DELETE FORK slashdot'.
+14:41.16 shm: Processing 'DELETE FORK kernel'.
+15:04.15 !ERROR! limitcheck: dont have ops on #debian-bots.
+15:21.46 >>> join/#debian-bots GmLB (danny@d239-76.hcvlny.optonline.net)
+15:21.51 >>> GmLB has signed off IRC ([x]chat)
+15:21.58 HUP called.
+15:21.58 Closed MySQL connection to localhost.
+15:21.58 Closed shared memory (shm) key: [718854]
+15:21.58 Loading ignore list...
+15:21.58 dpkg!*@*.com
+15:21.58 *!*@*.il
+15:21.58 apt!*@*
+15:21.58 Loaded ignore infobot.ignore (3 masks)
+15:21.58 Loaded lang infobot.lang (59 items)
+15:21.58 Loaded ircServers ircII.servers (2 servers)
+15:21.58 Loaded userlist infobot.users (2 users)
+15:21.58 GmLB:
+15:21.58 flags: +mrsteon
+15:21.58 default:
+15:21.58 flags: +mrt
+15:21.58 Created shared memory (shm) key: [914566]
+15:21.58 Opened MySQL connection to localhost
+15:21.58 Setup: 9969 factoids.
+15:21.58 Initial memory usage: 8072 kB
+15:21.58 End of HUP.
+15:32.17 FORK(1273) fork starting for 'slashdot', PID == 1273.
+15:32.17 FORK(1273) !DEBUG! lMM: setting moduleAge{./src/Modules/Slashdot3.pl} = time();
+15:32.17 FORK(1273) myModule: Loaded Slashdot3.pl ...
+15:32.17 FORK(1273) MEM: (Slashdot3.pl) increased by 28 kB.
+15:32.19 FORK(1273) Module: Loaded LWP::UserAgent ...
+15:32.19 FORK(1273) MEM: (LWP::UserAgent) increased by 932 kB. (total: 9032 kB)
+15:32.20 FORK(1273) getURL: getting 'http://www.slashdot.org/slashdot.xml'
+15:32.21 FORK(1273) getURL: Done (took 1s, 3 k/sec)
+15:32.21 FORK(1273) sending slashdot update to #debian-bots.
+15:32.21 FORK(1273) -#debian-bots- Slashdot: News for nerds, stuff that matters -- Napster Shut Down Until Trial :: Peeking At The Future: "Perfect Mirror" Cables
+15:32.22 FORK(1273) fork: took 6s for slashdot.
+15:32.22 FORK(1273) fork finished for 'slashdot'.
+15:34.16 !ERROR! limitcheck: dont have ops on #debian-bots.
+15:36.16 shm: Processing 'DELETE FORK slashdot'.
+16:07.16 !ERROR! limitcheck: dont have ops on #debian-bots.
+16:29.17 FORK(1494) fork starting for 'slashdot', PID == 1494.
+16:29.17 FORK(1494) !DEBUG! lMM: setting moduleAge{./src/Modules/Slashdot3.pl} = time();
+16:29.17 FORK(1494) myModule: Loaded Slashdot3.pl ...
+16:29.17 FORK(1494) MEM: (Slashdot3.pl) increased by 28 kB.
+16:29.19 FORK(1494) Module: Loaded LWP::UserAgent ...
+16:29.19 FORK(1494) MEM: (LWP::UserAgent) increased by 932 kB. (total: 9032 kB)
+16:29.19 FORK(1494) getURL: getting 'http://www.slashdot.org/slashdot.xml'
+16:29.19 FORK(1494) Slashdot: no new headlines.
+16:29.19 FORK(1494) fork: took 2s for slashdot.
+16:29.19 FORK(1494) fork finished for 'slashdot'.
+16:31.16 shm: Processing 'DELETE FORK slashdot'.
+16:33.16 !ERROR! limitcheck: dont have ops on #debian-bots.
+17:01.17 !ERROR! limitcheck: dont have ops on #debian-bots.
+17:32.17 FORK(1801) fork starting for 'slashdot', PID == 1801.
+17:32.17 FORK(1801) !DEBUG! lMM: setting moduleAge{./src/Modules/Slashdot3.pl} = time();
+17:32.17 FORK(1801) myModule: Loaded Slashdot3.pl ...
+17:32.17 FORK(1801) MEM: (Slashdot3.pl) increased by 28 kB.
+17:32.21 FORK(1801) Module: Loaded LWP::UserAgent ...
+17:32.21 FORK(1801) MEM: (LWP::UserAgent) increased by 932 kB. (total: 9032 kB)
+17:32.21 FORK(1801) getURL: getting 'http://www.slashdot.org/slashdot.xml'
+17:32.22 FORK(1801) getURL: Done (took 1s, 3 k/sec)
+17:32.23 FORK(1801) Slashdot: no new headlines.
+17:32.23 FORK(1801) fork: took 6s for slashdot.
+17:32.23 FORK(1801) fork finished for 'slashdot'.
+17:34.17 !ERROR! limitcheck: dont have ops on #debian-bots.
+17:36.17 shm: Processing 'DELETE FORK slashdot'.
+18:05.17 !ERROR! limitcheck: dont have ops on #debian-bots.
+18:35.17 !ERROR! limitcheck: dont have ops on #debian-bots.
+18:36.17 FORK(2547) fork starting for 'slashdot', PID == 2547.
+18:36.17 FORK(2547) !DEBUG! lMM: setting moduleAge{./src/Modules/Slashdot3.pl} = time();
+18:36.17 FORK(2547) myModule: Loaded Slashdot3.pl ...
+18:36.17 FORK(2547) MEM: (Slashdot3.pl) increased by 32 kB.
+18:36.18 FORK(2547) Module: Loaded LWP::UserAgent ...
+18:36.18 FORK(2547) MEM: (LWP::UserAgent) increased by 932 kB. (total: 9036 kB)
+18:36.19 FORK(2547) getURL: getting 'http://www.slashdot.org/slashdot.xml'
+18:36.19 FORK(2547) Slashdot: no new headlines.
+18:36.19 FORK(2547) fork: took 2s for slashdot.
+18:36.19 FORK(2547) fork finished for 'slashdot'.
+18:40.16 shm: Processing 'DELETE FORK slashdot'.
+18:40.16 FORK(2553) fork starting for 'kernel', PID == 2553.
+18:40.16 FORK(2553) !DEBUG! lMM: setting moduleAge{./src/Modules/Kernel.pl} = time();
+18:40.16 FORK(2553) myModule: Loaded Kernel.pl ...
+18:40.16 FORK(2553) MEM: (Kernel.pl) increased by 60 kB.
+18:40.17 FORK(2553) sending kernel update to #debian-bots.
+18:40.17 FORK(2553) -#debian-bots- Kernel: The latest prepatch (alpha) version *appears* to be: 2.4.0-test5/pre6
+18:40.17 FORK(2553) fork: took 1s for kernel.
+18:40.17 FORK(2553) fork finished for 'kernel'.
+18:41.17 shm: Processing 'DELETE FORK kernel'.
+18:57.51 >>> join/#odd GmLB (danny@d239-76.hcvlny.optonline.net)
+18:57.52 >>> mode/#odd [+o GmLB] by ChanServ
+18:58.07 >>> join/#debian-bots GmLB (danny@d239-76.hcvlny.optonline.net)
+19:06.17 !ERROR! limitcheck: dont have ops on #debian-bots.
+19:08.19 !WARN! PERL: Use of uninitialized value at ./src/IRC/IrcHooks.pl line 196.
+19:08.19 DCC CHAT established with GmLB ()
+19:08.21 !DEBUG! chat: no pass required.
+19:08.21 DCC CHAT: user GmLB is here!
+19:08.21 =gmlb=
+19:08.31 =gmlb= .<pass>ynnad
+19:08.31 !DEBUG! lMM: setting moduleAge{./src/Modules/UserDCC.pl} = time();
+19:08.31 myModule: Loaded UserDCC.pl ...
+19:08.31 MEM: (UserDCC.pl) increased by 152 kB.
+19:08.31 !WARN! PERL: Use of uninitialized value at /usr/lib/perl5/Net/IRC/Connection.pm line 1414.
+19:08.31 !WARN! PERL: Use of uninitialized value at /usr/lib/perl5/Net/IRC/Connection.pm line 1436.
+19:08.31 =gmlb=
+19:08.33 =gmlb= well
+19:08.33 =gmlb=
+19:08.37 =gmlb= die
+19:08.37 =gmlb=
+19:08.39 =gmlb= .die
+19:08.39 !DEBUG! isFlag: userHandle == 'default'.
+19:08.39 DCC CHAT: <gmlb> die -- not enough flags.
+19:08.39 !WARN! pSR: dcc{'CHAT'}{gmlb} does not exist.
+19:08.39 =gmlb=
+19:33.07 !DEBUG! dcc_close: nick => 'GmLB'.
+19:33.07 DCC CHAT close from GmLB
+19:33.08 >>> GmLB has signed off IRC ([x]chat)
+19:33.36 parent caught SIGTERM (pid 859).
+19:33.38 QUIT InfoCup has quit IRC (BEE RICHT BAK)
+19:33.39 Closed MySQL connection to localhost.
+19:33.39 Closed shared memory (shm) key: [914566]
--- /dev/null
+--- Net/IRC/Connection.pm.orig Wed May 24 16:52:30 2000
++++ Net/IRC/Connection.pm Wed May 24 16:53:39 2000
+@@ -392,9 +392,8 @@
+ # Standard destructor method for the GC routines. (HAHAHAH! DIE! DIE! DIE!)
+ sub DESTROY {
+ my $self = shift;
++ # how ironic.
+ $self->handler("destroy", "nobody will ever use this");
+- $self->quit();
+- # anything else?
+ }
+
+
--- /dev/null
+--- 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;
+ }
--- /dev/null
+#!/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;
--- /dev/null
+#!/usr/bin/perl -w
+#
+# backup_table-slave.pl: Backup mysql tables
+# Author: xk <xk@leguin.openprojects.net>
+# 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";
--- /dev/null
+#!/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
+
+ # ./infobot removes the pid file.
+ echo "stale pid file; removing."
+# rm -f $PIDFILE
+fi
+
+cd $BOTDIR
+./infobot
--- /dev/null
+#!/usr/bin/perl
+# by the xk.
+###
+
+require "src/logger.pl";
+require "src/core.pl";
+
+require "src/Misc.pl";
+require "src/Files.pl";
+package MYSQL;
+require "src/Factoids/db_mysql.pl";
+package DBM;
+require "src/Factoids/db_dbm.pl";
+package 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 all the data...
+&loadConfig("files/infobot.config");
+$dbname = $param{'DBFile'};
+my $dbh_mysql = MYSQL::openDB();
+DBM::openDB();
+
+print "scalar db == '". scalar(keys %db) ."'.\n";
+
+my ($ndef, $i) = (1,1);
+my $factoid;
+foreach $factoid (keys %db) {
+ foreach (@DBM::extra_format) {
+ my $val = &DBM::getFactInfo($key, $_, $db{$key});
+ if (!defined $val) {
+ $ndef++;
+ next;
+ }
+ &MYSQL::setFactInfo($key, $_, $val); # fact, type, what
+ }
+ $i++;
+ print "i=$i... " if ($i % 100 == 0);
+ print "ndef=$ndef... " if ($ndef % 1000 == 0);
+}
+
+print "Done.\n";
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+
+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,$dbname,0444) or die "error: cannot open db.\n";
+foreach (keys %db) {
+ next if /=>/; # skip the key if it contains the delimiter.
+
+ print "$_ => $db{$_}\n";
+}
+dbmclose %db;
--- /dev/null
+#!/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();
--- /dev/null
+#!/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($infobot_misc_dir."/infobot.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;
+}
--- /dev/null
+#!/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);
+}
+
--- /dev/null
+#!/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";
+$infobot_src_dir = "./src/";
+
+my $dbname = shift;
+if (!defined $dbname) {
+ print "Usage: $0 <db name>\n";
+ print "Example: $0 factoids\n";
+ exit 0;
+}
+
+# open the db.
+&loadConfig("files/infobot.config");
+&loadDBModules();
+
+&openDB();
+
+# 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();
--- /dev/null
+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");
--- /dev/null
+@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";
+}
--- /dev/null
+#!/usr/bin/perl -w
+
+# leading and trailing context lines.
+my $contextspread = 2;
+
+use strict;
+
+$| = 1;
+
+if (!scalar @ARGV) {
+ print "Usage: parse_warn.pl <files>\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 = ' value 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 (<FILE>) {
+ 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 = <IN>;
+ 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";
+ }
+}
--- /dev/null
+#!/usr/bin/perl
+# setup_tables: setup MYSQL/PGSQL side of things for blootbot.
+# written by the xk.
+###
+
+require "src/core.pl";
+require "src/logger.pl";
+require "src/modules.pl";
+require "src/Misc.pl";
+
+$infobot_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 teh config file was not loaded properly.\n";
+ exit 1;
+}
+
+if ($param{'DBType'} =~ /mysql/i) {
+ use DBI;
+ &openDB();
+
+ # retrieve a list of db's from the server.
+ my %db;
+ foreach ($dbh->func('_ListTables')) {
+ $db{$_} = 1;
+ }
+
+ # Step 4.
+ print "Step 4: Creating the tables.\n";
+
+ # factoid db.
+ if (!exists $db{'factoids'}) {
+ print " creating new table factoids...\n";
+
+ $query = "CREATE TABLE factoids (".
+ "factoid_key VARCHAR(64) NOT NULL,".
+
+ "requested_by VARCHAR(64),".
+ "requested_time INT,".
+ "requested_count SMALLINT UNSIGNED,".
+ "created_by VARCHAR(64),".
+ "created_time INT,".
+
+ "modified_by VARCHAR(192),".
+ "modified_time INT,".
+
+ "locked_by VARCHAR(64),".
+ "locked_time INT,".
+
+ "factoid_value TEXT NOT NULL,".
+
+ "PRIMARY KEY (factoid_key)".
+ ")";
+
+ &dbRaw("create(factoids)", $query);
+ }
+
+ # freshmeat.
+ if (!exists $db{'freshmeat'}) {
+ print " creating new table freshmeat...\n";
+
+ $query = "CREATE TABLE freshmeat (".
+ "name VARCHAR(64) NOT NULL,".
+ "stable VARCHAR(32),".
+ "devel VARCHAR(32),".
+ "section VARCHAR(40),".
+ "license VARCHAR(32),".
+ "homepage VARCHAR(128),".
+ "download VARCHAR(128),".
+ "changelog VARCHAR(128),".
+ "deb VARCHAR(128),".
+ "rpm VARCHAR(128),".
+ "link CHAR(55),".
+ "oneliner VARCHAR(96) NOT NULL,".
+
+ "PRIMARY KEY (name)".
+ ")";
+
+ &dbRaw("create(freshmeat)", $query);
+ }
+
+ # karma.
+ if (!exists $db{'karma'}) {
+ print " creating new table karma...\n";
+
+ $query = "CREATE TABLE karma (".
+ "nick VARCHAR(20) NOT NULL,".
+ "karma SMALLINT UNSIGNED,".
+
+ "PRIMARY KEY (nick)".
+ ")";
+
+ &dbRaw("create(karma)", $query);
+ }
+
+ # rootwarn.
+ if (!exists $db{'rootwarn'}) {
+ print " creating new table rootwarn...\n";
+
+ $query = "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)".
+ ")";
+
+ &dbRaw("create(rootwarn)", $query);
+ }
+
+ # seen.
+ if (!exists $db{'seen'}) {
+ print " creating new table seen...\n";
+
+ $query = "CREATE TABLE seen (".
+ "nick VARCHAR(20) NOT NULL,".
+ "time INT NOT NULL,".
+ "channel VARCHAR(20) NOT NULL,".
+ "host VARCHAR(80) NOT NULL,".
+ "messagecount SMALLINT UNSIGNED,".
+ "hehcount SMALLINT UNSIGNED,".
+ "message TINYTEXT NOT NULL,".
+
+ "PRIMARY KEY (nick)".
+ ")";
+
+ &dbRaw("create(seen)", $query);
+ }
+} elsif ($param{'DBType'} =~ /pgsql|postgres/i) {
+ if ($param{'DBType'} =~ /pgsql|postgres/i) { use Pg; } # for runtime.
+ my $dbh = Pg::connectdb("dbname=$dbname");
+
+ if (PGRES_CONNECTION_OK eq $conn->status) {
+ print " opened mysql connection to $param{'mysqlHost'}\n";
+ } else {
+ print " error: cannot connect to $param{'mysqlHost'}.\n";
+ print " $conn->errorMessage\n";
+ exit 1;
+ }
+
+ # retrieve a list of db's from the server.
+ my %db;
+ foreach ($dbh->func('_ListTables')) {
+ $db{$_} = 1;
+ }
+
+ # Step 4.
+ print "Step 4: Creating the tables.\n";
+
+ # factoid db.
+ if (!exists $db{'factoids'}) {
+ print " creating new table factoids...\n";
+
+ $query = "CREATE TABLE factoids (".
+ "factoid_key varying(64) NOT NULL,".
+
+ "requested_by varying(64),".
+ "requested_time numeric(11,0),".
+ "requested_count numeric(5,0),".
+ "created_by varying(64),".
+ "created_time numeric(11,0),".
+
+ "modified_by character varying(192),".
+ "modified_time numeric(11,0),".
+
+ "locked_by character varying(64),".
+ "locked_time numeric(11,0),".
+
+ "factoid_value text NOT NULL,".
+
+ "PRIMARY KEY (factoid_key)".
+ ")";
+
+ &dbRaw("create(factoids)", $query);
+ }
+
+ # freshmeat.
+ if (!exists $db{'freshmeat'}) {
+ print " creating new table freshmeat...\n";
+
+ $query = "CREATE TABLE freshmeat (".
+ "name charcter varying(64) NOT NULL,".
+ "stable character varying(32),".
+ "devel character varying(32),".
+ "section character varying(40),".
+ "license character varying(32),".
+ "homepage character varying(128),".
+ "download character varying(128),".
+ "changelog character varying(128),".
+ "deb character varying(128),".
+ "rpm character varying(128),".
+ "link character varying(55),".
+ "oneliner character varying(96) NOT NULL,".
+
+ "PRIMARY KEY (name)".
+ ")";
+
+ &dbRaw("create(freshmeat)", $query);
+ }
+
+ # karma.
+ if (!exists $db{'karma'}) {
+ print " creating new table karma...\n";
+
+ $query = "CREATE TABLE karma (".
+ "nick character varying(20) NOT NULL,".
+ "karma numeric(5,0),".
+
+ "PRIMARY KEY (nick)".
+ ")";
+
+ &dbRaw("create(karma)", $query);
+ }
+
+ # rootwarn.
+ if (!exists $db{'rootwarn'}) {
+ print " creating new table rootwarn...\n";
+
+ $query = "CREATE TABLE rootwarn (".
+ "nick character varying(20) NOT NULL,".
+ "attempt numeric(5,0),".
+ "time numeric(11,0) NOT NULL,".
+ "host character varying(80) NOT NULL,".
+ "channel character varying(20) NOT NULL,".
+
+ "PRIMARY KEY (nick)".
+ ")";
+
+ &dbRaw("create(rootwarn)", $query);
+ }
+
+ # seen.
+ if (!exists $db{'seen'}) {
+ print " creating new table seen...\n";
+
+ $query = "CREATE TABLE seen (".
+ "nick character varying(20) NOT NULL,".
+ "time numeric(11,0) NOT NULL,".
+ "channel character varying(20) NOT NULL,".
+ "host character varying(80) NOT NULL,".
+ "messagecount numeric(5,0),".
+ "hehcount numeric(5,0),".
+ "message text NOT NULL,".
+
+ "PRIMARY KEY (nick)".
+ ")";
+
+ &dbRaw("create(seen)", $query);
+ }
+}
+
+&closeDB();
+
+print "Done.\n";
--- /dev/null
+#!/usr/bin/perl
+# setup_users: setup MYSQL/PGSQL side of things for blootbot.
+# written by the xk.
+###
+
+require "src/core.pl";
+require "src/Misc.pl";
+require "src/logger.pl";
+
+&loadConfig("files/infobot.config");
+my $dbname = $param{'DBName'};
+my $query;
+
+if ($dbname eq "") {
+ print "error: appears that teh config file was not loaded properly.\n";
+ exit 1;
+}
+
+if ($param{'DBType'} =~ /mysql/i) {
+ if (!scalar @ARGV) {
+ print "hi there.\n\n";
+
+ print "if you're running a new version of mysql (debian potato), run\n";
+ print "this script with the '1' parameter while '0' for older versions\n";
+ print "(debian slink).\n";
+ exit 0;
+ }
+
+ my $mysqlversion;
+ if ($ARGV[0] =~ /^\d+$/) {
+ if ($ARGV[0] == 0) {
+ $mysqlversion = 0;
+ } elsif ($ARGV[0] == 1) {
+ $mysqlversion = 1;
+ } else {
+ print "error: wrong integer?\n";
+ }
+ } else {
+ print "error: wrong argument?\n";
+ exit 1;
+ }
+
+ print "Enter root information...\n";
+ # username.
+ print "Username: ";
+ chop (my $adminuser = <STDIN>);
+
+ # passwd.
+ system "stty -echo";
+ print "Password: ";
+ chop(my $adminpass = <STDIN>);
+ print "\n";
+ system "stty echo";
+
+ if ($adminuser eq "" or $adminpass eq "") {
+ print "error: adminuser || adminpass is NULL.\n";
+ exit 1;
+ }
+
+ # Step 1.
+ print "Step 1: Adding user information.\n";
+
+ # open the db.
+ &openDB();
+
+ # Step 2.
+ if (!&sqlGet("user","user",$param{'mysqlUser'},"user")) {
+ print " Adding user $param{'mysqlUser'} $dbname/user table...\n";
+
+ $query = "INSERT INTO user VALUES ".
+ "('localhost', '$param{'mysqlUser'}', ".
+ "password('$param{'mysqlPass'}'), ";
+
+ if ($mysqlversion) {
+ $query .= "'Y','Y','Y','Y','N','N','N','N','N','N','N','N','N','N')";
+ } else {
+ $query .= "'Y','Y','Y','Y','N','N','N','N','N','N')";
+ }
+
+ &dbRaw("create(user)", $query);
+ }
+
+ # Step 3. what's this for?
+ if (!&sqlGet("db","db",$param{'mysqlUser'},"db")) {
+ print " Adding 'db' entry\n";
+
+ $query = "INSERT INTO db VALUES ".
+ "('localhost', '$dbname', ".
+ "'$param{'mysqlUser'}', ";
+
+ if ($mysqlversion) {
+ $query .= "'Y','Y','Y','Y','Y','N','N','N','N','N')";
+ } else {
+ $query .= "'Y','Y','Y','Y','Y','N')";
+ }
+
+ &dbRaw("create(db)", $query);
+ }
+
+ # grant.
+ print " Granting user access to table.\n";
+ $query = "GRANT SELECT,INSERT,UPDATE,DELETE ON $dbname TO $param{'mysqlUser'}";
+ &dbRaw($query);
+
+ # flush.
+ print "Flushing privileges...\n";
+ $query = "FLUSH PRIVILEGES"; # DOES NOT WORK on slink?
+ &dbRaw("mysql(flush)", $query);
+
+ # create database.
+ print "Creating database $param{'DBName'}...\n";
+ $query = "CREATE DATABASE $param{'DBName'}";
+ &dbRaw("create(db $param{'DBName'})", $query);
+} elsif ($param{'DBType'} =~ /pg|postgres/i) {
+ use Pg;
+ &openDB();
+
+ print "FIXME\n";
+}
+
+&closeDB();
--- /dev/null
+@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";
+}
--- /dev/null
+#!/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 <input.txt>\n";
+ exit 0;
+}
+
+# open the txtfile.
+my $txtfile = shift;
+open(IN,$txtfile) or die "error: cannot open txtfile '$txtfile'.\n";
+
+# read the infobot config.
+&loadConfig("files/infobot.config");
+&loadDBModules();
+&openDB();
+
+### now pipe all the data to the mysql server...
+my $i = 1;
+print "converting factoid db to mysql...\n";
+while (<IN>) {
+ 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();
--- /dev/null
+#!/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";
+}
--- /dev/null
+#!/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 (<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 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<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 $index{$day}\n";
+ unlink $backup_destdir."/".$index{$day};
+ }
+}
+close OUT;
+
+print "Done.\n";
--- /dev/null
+#
+# Infobot user extension stubs
+#
+
+if (&IsParam("useStrict")) { use strict; }
+
+use vars qw(@W3Search_engines $W3Search_regex);
+@W3Search_engines = qw(AltaVista Dejanews Excite Gopher HotBot Infoseek
+ Lycos Magellan PLweb SFgate Simple Verity Google);
+$W3Search_regex = join '|', @W3Search_engines;
+
+### PROPOSED COMMAND HOOK IMPLEMENTATION.
+# addCmdHook('TEXT_HOOK', $code_ref,
+# (Forker => 1,
+# Identifier => 'config_label',
+# Help => 'help_label',
+# Cmdstats => 'text_label',)
+#}
+### EXAMPLE
+# addCmdHook('d?find', \&debianFind(), (
+# Forker => 1,
+# Identifier => "debian",
+# Help => "dfind",
+# Cmdstats => "Debian Search",) );
+### NOTES:
+# * viable solution?
+###
+
+sub Modules {
+ if (!defined $message) {
+ &WARN("Modules: message is undefined. should never happen.");
+ return;
+ }
+
+ # babel bot: Jonathan Feinberg++
+ if (&IsParam("babelfish") and $message =~ m{
+ ^\s*
+ (?:babel(?:fish)?|x|xlate|translate)
+ \s+
+ (to|from) # direction of translation (through)
+ \s+
+ ($babel::lang_regex)\w* # which language?
+ \s*
+ (.+) # The phrase to be translated
+ }xoi) {
+
+ &Forker("babelfish", sub { &babel::babelfish(lc $1, lc $2, $3); } );
+
+ $cmdstats{'BabelFish'}++;
+ return 'NOREPLY';
+ }
+
+ # cookie (random). xk++
+ if ($message =~ /^(cookie|random)(\s+(.*))?$/i) {
+ return 'NOREPLY' unless (&hasParam("cookie"));
+
+ my $arg = $3;
+
+ # lets find that secret cookie.
+ my $target = $talkchannel;
+ $target = $who if ($msgType ne 'public');
+
+ 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);
+ $val = &getFactInfo("factoids", $key, "factoid_value");
+ } else {
+ ($key,$value) = &randKey("factoids","factoid_key,factoid_value");
+ }
+
+ $cookiemsg =~ s/##KEY/\002$key\002/;
+ $cookiemsg =~ s/##VALUE/$value/;
+ $cookiemsg =~ s/##WHO/$who/;
+ $cookiemsg =~ s/\$who/$who/; # cheap fix.
+ $cookiemsg =~ s/(\S+)?\s*<\S+>/$1 /;
+ $cookiemsg =~ s/\s+/ /g;
+
+ if ($cookiemsg =~ s/^ACTION //i) {
+ &action($target, $cookiemsg);
+ } else {
+ &msg($target, $cookiemsg);
+ }
+
+ $cmdstats{'Random Cookie'}++;
+ return 'NOREPLY';
+ }
+
+ if ($message =~ /^d?bugs$/i) {
+ return 'NOREPLY' unless (&hasParam("debianExtra"));
+
+ &Forker("debianExtra", sub { &debianBugs(); } );
+
+ $cmdstats{'Debian Bugs'}++;
+ return 'NOREPLY';
+ }
+
+ # Debian Author Search.
+ if ($message =~ /^dauthor(\s+(.*))?$/i) {
+ return 'NOREPLY' unless (&hasParam("debian"));
+
+ my $query = $2;
+ if (!defined $query) {
+ &help("dauthor");
+ return 'NOREPLY';
+ }
+
+ &Forker("debian", sub { &Debian::searchAuthor($query); } );
+
+ $cmdstats{'Debian Author Search'}++;
+ return 'NOREPLY';
+ }
+
+ # Debian Incoming Search.
+ if ($message =~ /^dincoming$/i) {
+ return 'NOREPLY' unless (&hasParam("debian"));
+
+ &Forker("debian", sub { &Debian::generateIncoming(); } );
+
+ $cmdstats{'Debian Incoming Search'}++;
+ return 'NOREPLY';
+ }
+
+ # Debian Distro(Package) Stats
+ if ($message =~ /^dstats(\s+(.*))?$/i) {
+ return 'NOREPLY' unless (&hasParam("debian"));
+ my $dist = $2 || $Debian::defaultdist;
+
+ &Forker("debian", sub { &Debian::infoStats($dist); } );
+
+ $cmdstats{'Debian Statistics'}++;
+ return 'NOREPLY';
+ }
+
+ # Debian Contents search.
+ if ($message =~ /^d?contents(\s+(.*))?$/i) {
+ return 'NOREPLY' unless (&hasParam("debian"));
+
+ my $query = $2;
+ if (!defined $query) {
+ &help("contents");
+ return 'NOREPLY';
+ }
+
+ &Forker("debian", sub { &Debian::searchContents($query); } );
+
+ $cmdstats{'Debian Contents Search'}++;
+ return 'NOREPLY';
+ }
+
+ # Debian Package info.
+ if ($message =~ /^d?find(\s+(.*))?$/i and &IsParam("debian")) {
+ my $string = $2;
+
+ if (!defined $string) {
+ &help("find");
+ return 'NOREPLY';
+ }
+
+ &Forker("debian", sub { &Debian::DebianFind($string); } );
+ return 'NOREPLY';
+ }
+
+ if (&IsParam("debian")) {
+ my $debiancmd = 'conflicts?|depends?|desc|file|info|provides?';
+ $debiancmd .= '|recommends?|suggests?|maint|maintainer';
+ if ($message =~ /^($debiancmd)(\s+(.*))?$/i) {
+ my $package = lc $3;
+
+ if (defined $package) {
+ &Forker("debian", sub { &Debian::infoPackages($1, $package); } );
+ } else {
+ &help($1);
+ }
+
+ return 'NOREPLY';
+ }
+ }
+
+ # Dict. xk++
+ if ($message =~ /^dict(\s+(.*))?$/i) {
+ return 'NOREPLY' unless (&hasParam("dict"));
+
+ my $query = $2;
+ $query =~ s/^[\s\t]+//;
+ $query =~ s/[\s\t]+$//;
+ $query =~ s/[\s\t]+/ /;
+
+ if (!defined $query) {
+ &help("dict");
+ return 'NOREPLY';
+ }
+
+ if (length $query > 30) {
+ &msg($who,"dictionary word is too long.");
+ return 'NOREPLY';
+ }
+
+ &Forker("dict", sub { &Dict::Dict($query); } );
+
+ $cmdstats{'Dict'}++;
+ return 'NOREPLY';
+ }
+
+ # Freshmeat. xk++
+ if ($message =~ /^(fm|freshmeat)(\s+(.*))?$/i) {
+ return 'NOREPLY' unless (&hasParam("freshmeat"));
+
+ my $query = $3;
+
+ if (!defined $query) {
+ &help("freshmeat");
+ &msg($who, "I have \002".&countKeys("freshmeat")."\002 entries.");
+ return 'NOREPLY';
+ }
+
+ &loadMyModule($myModules{'freshmeat'});
+ &Freshmeat::Freshmeat($query);
+
+ $cmdstats{'Freshmeat'}++;
+ return 'NOREPLY';
+ }
+
+ # google searching. Simon++
+ if (&IsParam("wwwsearch") and $message =~ /^(?:search\s+)?($W3Search_regex)\s+for\s+['"]?(.*?)['"]?\s*\?*$/i) {
+ return 'NOREPLY' unless (&hasParam("wwwsearch"));
+
+ &Forker("wwwsearch", sub { &W3Search::W3Search($1,$2,$param{'wwwsearch'}); } );
+
+ $cmdstats{'WWWSearch'}++;
+ return 'NOREPLY';
+ }
+
+ # insult server. patch thanks to michael@limit.org
+ if ($message =~ /^insult(\s+(\S+))?$/) {
+ return 'NOREPLY' unless (&hasParam("insult"));
+
+ my $person = $2;
+ if (!defined $person) {
+ &help("insult");
+ return 'NOREPLY';
+ }
+
+ &Forker("insult", sub { &Insult::Insult($person); } );
+
+ return 'NOREPLY';
+ }
+
+ # Kernel. xk++
+ if ($message =~ /^kernel$/i) {
+ return 'NOREPLY' unless (&hasParam("kernel"));
+
+ &Forker("kernel", sub { &Kernel::Kernel(); } );
+
+ $cmdstats{'Kernel'}++;
+ return 'NOREPLY';
+ }
+
+ # LART. originally by larne/cerb.
+ if ($message =~ /^lart(\s+(.*))?$/i) {
+ return 'NOREPLY' unless (&hasParam("lart"));
+ my ($target) = &fixString($2);
+
+ if (!defined $target) {
+ &help("lart");
+ return 'NOREPLY';
+ }
+ my $extra = 0;
+
+ my $chan = $talkchannel;
+ 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 'NOREPLY';
+ }
+ }
+
+ my $line = &getRandomLineFromFile($infobot_misc_dir. "/infobot.lart");
+ if (defined $line) {
+ if ($target =~ /^(me|you|itself|\Q$ident\E)$/i) {
+ $line =~ s/WHO/$who/g;
+ } else {
+ $line =~ s/WHO/$target/g;
+ }
+ $line .= ", courtesy of $who" if ($extra);
+
+ &action($chan, $line);
+ } else {
+ &status("lart: error reading file?");
+ }
+
+ return 'NOREPLY';
+ }
+
+ # Search factoid extensions by 'author'. xk++
+ if ($message =~ /^listauth(\s+(\S+))?$/i) {
+ return 'NOREPLY' unless (&hasParam("search"));
+
+ my $query = $2;
+
+ if (!defined $query) {
+ &help("listauth");
+ return 'NOREPLY';
+ }
+
+ &loadMyModule($myModules{'factoids'});
+ &performStrictReply( &CmdListAuth($query) );
+ return 'NOREPLY';
+ }
+
+ # list{keys|values}. xk++. Idea taken from #linuxwarez@EFNET
+ if ($message =~ /^list(\S+)( (.*))?$/i) {
+ return 'NOREPLY' unless (&hasParam("search"));
+
+ my $thiscmd = lc($1);
+ my $args = $3;
+
+ $thiscmd =~ s/^vals$/values/;
+ return 'NOREPLY' if ($thiscmd ne "keys" && $thiscmd ne "values");
+
+ # Usage:
+ if (!defined $args) {
+ &help("list". $thiscmd);
+ return 'NOREPLY';
+ }
+
+ if (length $args == 1) {
+ &msg($who,"search string is too short.");
+ return 'NOREPLY';
+ }
+
+ ### chews up to 4megs => use forker :)
+ &Forker("search", sub { &Search::Search($thiscmd, $args); } );
+# &loadMyModule($myModules{'search'});
+# &Search::Search($thiscmd, $args);
+
+ $cmdstats{'Factoid Search'}++;
+ return 'NOREPLY';
+ }
+
+ # Nickometer. Adam Spiers++
+ if ($message =~ /^(?:lame|nick)ometer(?: for)? (\S+)/i) {
+ return 'NOREPLY' unless (&hasParam("nickometer"));
+
+ my $term = (lc $1 eq 'me') ? $who : $1;
+ $term =~ s/\?+\s*//;
+
+ &loadMyModule($myModules{'nickometer'});
+ my $percentage = &nickometer($term);
+
+ if ($percentage =~ /NaN/) {
+ $percentage = "off the scale";
+ } else {
+ $percentage = sprintf("%0.4f", $percentage);
+ $percentage =~ s/\.?0+$//;
+ $percentage .= '%';
+ }
+
+ if ($msgType eq 'public') {
+ &say("'$term' is $percentage lame, $who");
+ } else {
+ &msg($who, "the 'lame nick-o-meter' reading for $term is $percentage, $who");
+ }
+
+ return 'NOREPLY';
+ }
+
+ # Quotes. mu++
+ if ($message =~ /^quote(\s+(\S+))?$/i) {
+ return 'NOREPLY' unless (&hasParam("quote"));
+
+ my $query = $2;
+
+ if ($query eq "") {
+ &help("quote");
+ return 'NOREPLY';
+ }
+
+ &Forker("quote", sub { &Quote::Quote($query); } );
+
+ $cmdstats{'Quote'}++;
+ return 'NOREPLY';
+ }
+
+ # rootWarn. xk++
+ if ($message =~ /^rootWarn$/i) {
+ return 'NOREPLY' unless (&hasParam("rootWarn"));
+
+ &loadMyModule($myModules{'rootwarn'});
+ &performStrictReply( &CmdrootWarn() );
+ return 'NOREPLY';
+ }
+
+ # seen.
+ if ($message =~ /^seen(\s+(\S+))?$/) {
+ return 'NOREPLY' unless (&hasParam("seen"));
+
+ my $person = $2;
+ if (!defined $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 'NOREPLY';
+ }
+
+ my @seen;
+ $person =~ s/\?*$//;
+
+ &seenFlush(); # very evil hack. oh well, better safe than sorry.
+
+ ### TODO: Support &dbGetRowInfo(); like in &FactInfo();
+ my $select = "nick,time,channel,host,message";
+ if ($person eq "random") {
+ @seen = &randKey("seen", $select);
+ } else {
+ @seen = &dbGet("seen", "nick", $person, $select);
+ }
+
+ if (scalar @seen < 2) {
+ foreach (@seen) {
+ &DEBUG("seen: _ => '$_'.");
+ }
+ &performReply("i haven't seen '$person'");
+ return 'NOREPLY';
+ }
+
+ # 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 (&IsParam("seenStats")) {
+ 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);
+ }
+ } 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 'NOREPLY';
+ }
+
+ # slashdot headlines: from Chris Tessone.
+ if ($message =~ /^slashdot$/i) {
+ return 'NOREPLY' unless (&hasParam("slashdot"));
+
+ &Forker("slashdot", sub { &Slashdot::Slashdot() });
+
+ $cmdstats{'Slashdot'}++;
+ return 'NOREPLY';
+ }
+
+ # Topic management. xk++
+ # may want to add a flag(??) for topic in the near future. -xk
+ if ($message =~ /^topic(\s+(.*))?$/i) {
+ return 'NOREPLY' unless (&hasParam("topic"));
+
+ my $chan = $talkchannel;
+ my @args = split(/ /, $2);
+
+ if (!scalar @args) {
+ &msg($who,"Try 'help topic'");
+ return 'NOREPLY';
+ }
+
+ $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 <CMD>");
+ return 'NOREPLY';
+ }
+
+ # topic over private:
+ if ($msgType eq 'private' && $chan !~ /^#/) {
+ &msg($who, "error: channel argument is required.");
+ &msg($who, "\002Usage\002: topic #channel <CMD>");
+ return 'NOREPLY';
+ }
+
+ if (&validChan($chan) == 0) {
+ &msg($who,"error: invalid channel \002$chan\002");
+ return 'NOREPLY';
+ }
+
+ # for semi-outsiders.
+ if (!&IsNickInChan($who,$chan)) {
+ &msg($who, "Failed. You ($who) are not in $chan, hey?");
+ return 'NOREPLY';
+ }
+
+ # now lets do it.
+ &loadMyModule($myModules{'topic'});
+ &Topic($chan, $thiscmd, join(' ', @args));
+ $cmdstats{'Topic'}++;
+ return 'NOREPLY';
+ }
+
+ # Countdown.
+ if ($message =~ /^countdown(\s+(\S+))?$/i) {
+ return 'NOREPLY' unless (&hasParam("countdown"));
+
+ my $query = $2;
+
+ &loadMyModule($myModules{'countdown'});
+ &Countdown($query);
+
+ $cmdstats{'Countdown'}++;
+
+ return 'NOREPLY';
+ }
+
+ # User Information Services. requested by Flugh.
+ if ($message =~ /^uinfo(\s+(.*))?$/i) {
+ return 'NOREPLY' unless (&hasParam("userinfo"));
+ &loadMyModule($myModules{'userinfo'});
+
+ my $arg = $1;
+ if (!defined $arg or $arg eq "") {
+ &help("uinfo");
+ return 'NOREPLY';
+ }
+
+ if ($arg =~ /^set(\s+(.*))?$/i) {
+ $arg = $2;
+ if (!defined $arg) {
+ &help("userinfo set");
+ return 'NOREPLY';
+ }
+
+ &UserInfoSet(split /\s+/, $arg, 2);
+ } elsif ($arg =~ /^unset(\s+(.*))?$/i) {
+ $arg = $2;
+ if (!defined $arg) {
+ &help("userinfo unset");
+ return 'NOREPLY';
+ }
+
+ &UserInfoSet($arg, "");
+ } else {
+ &UserInfoGet($arg);
+ }
+
+ $cmdstats{'UIS'}++;
+ return 'NOREPLY';
+ }
+
+ # Uptime. xk++
+ if ($message =~ /^uptime$/i) {
+ return 'NOREPLY' unless (&hasParam("uptime"));
+
+ my $count = 1;
+ &msg($who, "- Uptime for $ident -");
+ &msg($who, "Now: ". &Time2String(&uptimeNow()) ." running $infobot_version");
+ foreach (&uptimeGetInfo()) {
+ /^(\d+)\.\d+ (.*)/;
+ my $time = &Time2String($1);
+ my $info = $2;
+
+ &msg($who, "$count: $time $2");
+ $count++;
+ }
+
+ $cmdstats{'Uptime'}++;
+ return 'NOREPLY';
+ }
+
+ # wingate.
+ if ($message =~ /^wingate$/i) {
+ return 'NOREPLY' unless (&hasParam("wingate"));
+
+ my $reply = "Wingate statistics: scanned \002"
+ .scalar(keys %wingate)."\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 'NOREPLY';
+ }
+
+ # convert.
+ if ($message =~ /^convert(\s+(.*))?$/i) {
+ return 'NOREPLY' unless (&hasParam("units"));
+
+ my $str = $2;
+ if (!defined $str) {
+ &help("convert");
+ return 'NOREPLY';
+ }
+
+ my ($from,$to);
+ ($from,$to) = ($1,$2) if ($str =~ /^(.*) to (.*)$/);
+ ($from,$to) = ($2,$1) if ($str =~ /^(.*) from (.*)$/);
+ if (!defined $from or !defined $to or $to eq "" or $from eq "") {
+ &msg($who, "Invalid format!");
+ &help("convert");
+ return 'NOREPLY';
+ }
+
+ &Forker("units", sub { &Units::convertUnits($from, $to); } );
+
+ return 'NOREPLY';
+ }
+
+ # do nothing and let the other routines have a go
+ return '';
+}
+
+1;
--- /dev/null
+#
+# DBStubs.pl: DB independent (I hope, heh) factoid support
+# Author: xk <xk@leguin.openprojects.net>
+# Version: v0.6d (20000223)
+# Created: 19991020
+#
+
+if (&IsParam("useStrict")) { use strict; }
+
+#####
+# Usage: &setFactInfo($faqtoid, $type, $what, ?, ?);
+sub setFactInfo {
+ &dbSet("factoids", "factoid_key", $_[0], $_[1], $_[2]);
+}
+
+#####
+# 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", "");
+
+ return 1;
+}
+
+1;
--- /dev/null
+#
+# Norm.pl: Norm.
+# Author: Kevin Lenzo
+# Version: 1997
+#
+
+if (&IsParam("useStrict")) { use strict; }
+
+sub normquery {
+ my ($in) = @_;
+
+ $in = " $in ";
+
+ # where blah is -> where is blah
+ $in =~ s/ (where|what|who)\s+(\S+)\s+(is|are) / $1 $3 $2 /i;
+
+ # where blah is -> where is blah
+ $in =~ s/ (where|what|who)\s+(.*)\s+(is|are) / $1 $3 $2 /i;
+
+ $in =~ s/^\s*(.*?)\s*/$1/;
+
+ $in =~ s/be tellin\'?g?/tell/i;
+ $in =~ s/ \'?bout/ about/i;
+
+ $in =~ s/,? any(hoo?w?|ways?)/ /ig;
+ $in =~ 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
+ $in =~ s/th(e|at|is) (((m(o|u)th(a|er) ?)?fuck(in\'?g?)?|hell|heck|(god-?)?damn?(ed)?) ?)+//ig;
+ $in =~ s/wtf/where/gi;
+ $in =~ s/this (.*) thingy?/ $1/gi;
+ $in =~ s/this thingy? (called )?//gi;
+ $in =~ s/ha(s|ve) (an?y?|some|ne) (idea|clue|guess|seen) /know /ig;
+ $in =~ s/does (any|ne|some) ?(1|one|body) know //ig;
+ $in =~ s/do you know //ig;
+ $in =~ s/can (you|u|((any|ne|some) ?(1|one|body)))( please)? tell (me|us|him|her)//ig;
+ $in =~ s/where (\S+) can \S+ (a|an|the)?//ig;
+ $in =~ s/(can|do) (i|you|one|we|he|she) (find|get)( this)?/is/i; # where can i find
+ $in =~ s/(i|one|we|he|she) can (find|get)/is/gi; # where i can find
+ $in =~ s/(the )?(address|url) (for|to) //i; # this should be more specific
+ $in =~ s/(where is )+/where is /ig;
+ $in =~ s/\s+/ /g;
+ $in =~ s/^\s+//;
+ if ($in =~ s/\s*[\/?!]*\?+\s*$//) {
+ $finalQMark = 1;
+ }
+
+ $in =~ s/\s+/ /g;
+ $in =~ s/^\s*(.*?)\s*$/$1/;
+
+ $in;
+}
+
+# for be-verbs
+sub switchPerson {
+ my($in) = @_;
+
+ $in =~ s/(^|\W)\Q$who\Es\s+/$1${who}\'s /ig; # fix genitives
+ $in =~ s/(^|\W)\Q$who\Es$/$1${who}\'s/ig; # fix genitives
+ $in =~ s/(^|\W)\Q$who\E\'(\s|$)/$1${who}\'s$2/ig; # fix genitives
+ $in =~ s/(^|\s)i\'m(\W|$)/$1$who is$2/ig;
+ $in =~ s/(^|\s)i\'ve(\W|$)/$1$who has$2/ig;
+ $in =~ s/(^|\s)i have(\W|$)/$1$who has$2/ig;
+ $in =~ s/(^|\s)i haven\'?t(\W|$)/$1$who has not$2/ig;
+ $in =~ s/(^|\s)i(\W|$)/$1$who$2/ig;
+ $in =~ s/ am\b/ is/i;
+ $in =~ s/\bam /is/i;
+ $in =~ s/(^|\s)(me|myself)(\W|$)/$1$who$3/ig;
+ $in =~ s/(^|\s)my(\W|$)/$1${who}\'s$2/ig; # turn 'my' into name's
+ $in =~ s/(^|\W)you\'?re(\W|$)/$1you are$2/ig;
+
+ if ($addressed) {
+ $in =~ s/yourself/$param{'ircNick'}/i;
+ $in =~ s/(^|\W)are you(\W|$)/$1is $param{'ircNick'}$2/ig;
+ $in =~ s/(^|\W)you are(\W|$)/$1$param{'ircNick'} is$2/ig;
+ $in =~ s/(^|\W)you(\W|$)/$1$param{'ircNick'}$2/ig;
+ $in =~ s/(^|\W)your(\W|$)/$1$param{'ircNick'}\'s$2/ig;
+ }
+
+ $in;
+}
+
+# ---
+
+1;
--- /dev/null
+# infobot :: Kevin Lenzo (c) 1997
+
+## doQuestion --
+## if ($query == query) {
+## return $value;
+## } else {
+## return NULL;
+## }
+##
+##
+
+if (&IsParam("useStrict")) { use strict; }
+
+use vars qw($query $reply $finalQMark $nuh $result $talkok $who $nuh);
+use vars qw(%infobots %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*$//;
+
+ if (!defined $query or $query =~ /^\s*$/) {
+ &FIXME("doQ: query == NULL");
+ return '';
+ }
+
+ my $origQuery = $query;
+
+ my $questionWord = "";
+
+ if (!$addressed) {
+ return '' unless ($finalQMark);
+
+ if (&IsParam("minVolunteerLength") == 0 or
+ length($query) < $param{'minVolunteerLength'})
+ {
+ return '';
+ }
+ } else {
+ ### TODO: this should be caught in Process.pl?
+ return '' unless ($talkok);
+ }
+
+ # dangerous; common preambles should be stripped before here
+ if ($query =~ /^forget /i or $query =~ /^no, /) {
+ return 'NOREPLY' if (exists $infobots{$nuh});
+ }
+
+ # convert to canonical reference form
+ $query = &normquery($query);
+ $query = &switchPerson($query);
+
+ $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'}};
+
+ # what's whats => what is; who'?s => who is, etc
+ $query =~ s/ ($qregex)\'?s / $1 is /i;
+ if ($query =~ s/\s+($qregex)\s+//i) { # check for question word
+ $questionWord = lc($1);
+ }
+
+ if ($questionWord eq "" and $finalQMark and $addressed) {
+ $questionWord = "where";
+ }
+
+ $query =~ s/^\s+|\s+$//g;
+
+ # valid factoid.
+ if (defined( $result = &getReply($query) )) {
+ # 'see also' factoid redirection support.
+ if ($result =~ /^see( also)? (.*?)\.?$/) {
+ my $newr = &getReply($2);
+ $result = $newr if ($newr ne "");
+ }
+
+ return $result if ($result ne "");
+
+ ### TODO: Use &Forker(); move function to Freshmeat.pl.
+ if (&IsParam("freshmeatForFactoid")) {
+ &loadMyModule($myModules{'freshmeat'});
+ $result = &Freshmeat::showPackage($query);
+ return $result unless ($result eq 'NOREPLY');
+ }
+
+ &DEBUG("Question: hrm... result => '$result'.");
+ }
+
+ if ($questionWord ne "" or $finalQMark) {
+ # if it has not been explicitly marked as a question
+ if ($addressed and $reply eq "") {
+ if ($origQuery eq $query) {
+ &status("notfound: <$who> $origQuery");
+ } else {
+ &status("notfound: <$who> $origQuery :: $query");
+ }
+
+ return '' unless (&IsParam("friendlyBots"));
+
+ foreach (split /\s+/, $param{'friendlyBots'}) {
+ &msg($_, ":INFOBOT:QUERY <$who> $query");
+ }
+ }
+ }
+
+ $reply;
+}
+
+1;
--- /dev/null
+# infobot :: Kevin Lenzo (c) 1997
+
+##
+# x is y === $lhs $mhs $rhs
+#
+# lhs - factoid.
+# mhs - verb.
+# rhs - factoid message.
+##
+
+if (&IsParam("useStrict")) { use strict; }
+
+use vars qw($msgType $uh $lastWho $ident);
+use vars qw(%lang %lastWho);
+
+sub getReply {
+ my($message) = @_;
+ my($lhs,$mhs,$rhs);
+ my($result,$reply);
+ my $literal = 0;
+ $orig{message} = $message;
+
+ if (!defined $message or $message =~ /^\s*$/) {
+ &WARN("getR: message == NULL.");
+ return '';
+ }
+
+ $message =~ tr/A-Z/a-z/;
+
+ if ($result = &getFactoid($message)) {
+ $lhs = $message;
+ $mhs = "is";
+ $rhs = $result;
+ } else {
+ return '';
+ }
+
+ # if there was a head...
+ my(@poss) = split '\|\|', $result;
+ $poss[0] =~ s/^\s//;
+ $poss[$#poss] =~ s/\s$//;
+
+ if ((@poss > 1) && ($msgType =~ /public/)) {
+ $result = &getRandom(@poss);
+ $result =~ s/^\s*//;
+ }
+
+ my $fauthor = &dbGet("factoids", "factoid_key", $message, "created_by");
+ ### we need non-evaluating regex like in factoid sar.
+ if ($msgType =~ /^private$/) {
+ if (defined $fauthor and $fauthor =~ /^\Q$who\E\!/i) {
+ &status("Reply.pl: author requested own factoid in private; literal!");
+ $literal = 1;
+ }
+ } else {
+ my $done = 0;
+
+ # (blah1|blah2)?
+ while ($result =~ /\((.*?)\)\?/) {
+ my $str = $1;
+ if (rand() > 0.5) { # fix.
+ &status("Factoid transform: keeping '$str'.");
+ $result =~ s/\(\Q$str\E\)\?/$str/;
+ } else { # remove
+ &status("Factoid transform: removing '$str'.");
+ $result =~ 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 ($result =~ /\((\d+)-(\d+)\)/) {
+ my ($lower,$upper) = ($1,$2);
+ my $new = int(rand $upper-$lower) + $lower;
+
+ &status("Reply.pl: SARing '$&' to '$new'.");
+ $result =~ s/$&/$new/;
+ $done++;
+ last if ($done >= 10); # just in case.
+ }
+ $done = 0;
+
+ # EG: (blah1|blah2|blah3|) => blah1
+ while ($result =~ /\((.*?\|.*?)\)/) {
+ my $str = $1;
+ my @rand = split /\|/, $str;
+ my $rand = $rand[rand @rand];
+
+ &status("Reply.pl: SARing '($str)' to '$rand'.");
+ $result =~ s/\(\Q$str\E\)/$rand/;
+ $done++;
+ last if ($done >= 10); # just in case.
+ }
+ &status("Reply.pl: $done SARs done.") if ($done);
+ }
+
+ $reply = $result;
+ if ($result ne "") {
+ ### AT LAST, REPEAT PREVENTION CODE REMOVED IN FAVOUR OF GLOBAL
+ ### FLOOD REPETION AND PROTECTION. -20000124
+
+ # stats code.
+ &setFactInfo($lhs,"requested_by", $nuh);
+ &setFactInfo($lhs,"requested_time", time());
+ ### FIXME: old mysql doesn't support
+ ### "requested_count=requested_count+1".
+ my $count = &getFactInfo($lhs,"requested_count") || 0;
+ $count++;
+ &setFactInfo($lhs,"requested_count", $count);
+
+ 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 '<reply>'
+ if (!$real and $reply =~ s/^\s*<reply>\s*//i) {
+ # 'are' fix.
+ if ($reply =~ s/^are //i) {
+ &DEBUG("Reply.pl: el-cheapo 'are' fix executed.");
+ $mhs = "are";
+ }
+
+ } elsif (!$real and $reply =~ s/^\s*<action>\s*(.*)/\cAACTION $1\cA/i) {
+ # only remove '<action>' and make it an action.
+ } else { # not a short reply
+
+ ### infobot-infobot reply.
+ if (exists $infobots{$nuh} and $rhs !~ /^\s*$/) {
+ return "$lhs $mhs $rhs";
+ }
+
+ ### infobot-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 'NOREPLY' if ($addressed);
+ }
+ }
+ }
+ }
+
+ return $reply if ($literal);
+
+ # remove excessive beginning and end whitespaces.
+ $reply =~ s/^\s+|\s+$//g;
+
+ if (length($reply) < 5 or $reply =~ /^\s+$/) {
+ &DEBUG("Reply: FIXME: reply => '$reply'.");
+ return '';
+ }
+
+ return $reply unless ($reply =~ /\$/);
+
+ ###
+ ### $ SUBSTITUTION.
+ ###
+
+ # $date, $time.
+ my $date = scalar(localtime());
+ $date =~ s/\:\d+(\s+\w+)\s+\d+$/$1/;
+ $reply =~ s/\$date/$date/gi;
+ $date =~ s/\w+\s+\w+\s+\d+\s+//;
+ $reply =~ s/\$time/$date/gi;
+
+ # dollar variables.
+ $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();
+ my $randp = int($rand*100);
+ $reply =~ s/\$randpercentage/$randp/g;
+ ### TODO: number of digits. 'x.y'
+ if ($reply =~ /\$rand(\d+)/) {
+ # will this work as it does in C?
+ $rand = sprintf("%*f", $1, $rand);
+ }
+ $reply =~ s/\$rand/$rand/g;
+ }
+
+ $reply =~ s/\$factoid/$lhs/g;
+ $reply =~ s/\$ident/$ident/g;
+
+ if ($reply =~ /\$startTime/) {
+ my $time = scalar(localtime $^T);
+ $reply =~ s/\$startTime/$time/;
+ }
+
+ if ($reply =~ /\$uptime/) {
+ my $uptime = &Time2String(time() - $^T);
+ $reply =~ s/\$uptime/$uptime/;
+ }
+
+ if ($reply =~ /\$factoids/) {
+ my $count = &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/;
+
+ $reply;
+}
+
+1;
--- /dev/null
+
+# infobot :: Kevin Lenzo (c) 1997
+
+##
+## doStatement --
+##
+## decide if $in is a statement, and if so,
+## - update the dbm
+## - return feedback statement
+##
+## otherwise return
+## - null for confused.
+## - NOREPLY not to respond.
+##
+
+if (&IsParam("useStrict")) { use strict; }
+
+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 'NOREPLY' unless ($learnok);
+
+ my($urlType) = "";
+
+ # prefix www with http:// and ftp with ftp://
+ $in =~ s/ www\./ http:\/\/www\./ig;
+ $in =~ s/ ftp\./ ftp:\/\/ftp\./ig;
+
+ # look for a "type nugget". this should be externalized.
+ $urlType = "mailto" if ($in =~ /\bmailto:.+\@.+\..{2,}/i);
+ $urlType = "mailto" if ($in =~ s/\b(\S+\@\S+\.\S{2,})/mailto:$1/gi);
+ $in =~ s/(mailto:)+/mailto:/g;
+
+ $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 'NOREPLY' if ($urlType eq "");
+ } elsif ($param{'acceptUrl'} eq 'REJECT') {
+ &status("REJECTED URL entry") if (&IsParam("VERBOSITY"));
+ return 'NOREPLY' unless ($urlType eq "");
+ } else {
+ # OPTIONAL
+ }
+ }
+
+ # learn statement. '$lhs is|are $rhs'
+ if ($in =~ /(^|\s)(is|are)(\s|$)/i) {
+ my($lhs, $mhs, $rhs) = ($`, $&, $');
+
+ $lhs =~ tr/A-Z/a-z/;
+ $lhs =~ s/^(the|da|an?)\s+//i; # discard article
+
+ # 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 'NOREPLY';
+ }
+
+ # lets check if it failed.
+ if (&validFactoid($lhs,$rhs) == 0) {
+ if ($addressed) {
+ &status("IGNORE statement: <$who> $message");
+ &performReply( &getRandom(keys %{$lang{'confused'}}) );
+ }
+ return 'NOREPLY';
+ }
+
+ return 'NOREPLY' if (!$addressed and $lhs =~ /\s+/);
+
+ &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 chan 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 'NOREPLY';
+ }
+ }
+
+ return &update($lhs, $mhs, $rhs);
+ }
+
+ return '';
+}
+
+1;
--- /dev/null
+#
+# Update.pl: Add or modify factoids in the db.
+# Author: Kevin Lenzo
+# xk <xk@leguin.openprojects.net>
+# Version: 19991209
+# Created: 1997
+#
+
+if (&IsParam("useStrict")) { use strict; }
+
+sub update {
+ my($lhs, $mhs, $rhs) = @_;
+
+ $lhs =~ s/^i (heard|think) //i;
+ $lhs =~ s/^some(one|1|body) said //i;
+ $lhs =~ s/\s+/ /g;
+
+ # locked.
+ return 'NOREPLY' if (&IsLocked($lhs) == 1);
+
+ # profanity.
+ if (&IsParam("profanityCheck") and &hasProfanity($rhs)) {
+ &msg($who, "please, watch your language.");
+ return 'NOREPLY';
+ }
+
+ # teaching.
+ if (&IsFlag("t") ne "t") {
+ &msg($who, "permission denied.");
+ &status("alert: $who wanted to teach me.");
+ return 'NOREPLY';
+ }
+
+ # nice 'are' hack (or work-around).
+ if ($mhs =~ /^are$/i and $rhs !~ /<\S+>/) {
+ $mhs = "is";
+ $rhs = "<REPLY> are ". $rhs;
+ }
+
+ # invalid verb.
+ if ($mhs !~ /^is$/i) {
+ &ERROR("UNKNOWN verb: $mhs.");
+ return;
+ }
+
+ # check if the arguments are too long to be stored in our table.
+ if (length($lhs) > $param{'maxKeySize'} or
+ length($rhs) > $param{'maxDataSize'})
+ {
+ &performAddressedReply("that's too long");
+ return 'NOREPLY';
+ }
+
+ #
+ # lets do it...
+ #
+
+ my $also = ($rhs =~ s/^also //i);
+ my $also_or = ($also and $rhs =~ s/\s+(or|\|\|)\s+//);
+
+ if (&IsParam("freshmeatForFactoid")) {
+ if (&dbGet("freshmeat", "name", $lhs, "name")) {
+ &msg($who, "permission denied. (freshmeat)");
+ &status("alert: $who wanted to teach me something that freshmeat already has info on.");
+ return 'NOREPLY';
+ }
+ }
+
+ if (my $exists = &getFactoid($lhs)) { # factoid exists.
+ chomp $exists;
+
+ if ($exists eq $rhs) {
+ &performAddressedReply("i already had it that way");
+ return 'NOREPLY';
+ }
+
+ if ($also) { # 'is also'.
+ if ($also_or) { # 'is also ||'.
+ $rhs = $exists.' || '.$rhs;
+ } else {
+ 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*$/) {
+ $rhs = $exists." ".$rhs;
+ } elsif ($rhs =~ /^\./) {
+ $rhs = $exists.$rhs;
+ } else {
+ $rhs = $exists.', or '.$rhs;
+ }
+ }
+
+ # max length check again.
+ if (length($rhs) > $param{'maxDataSize'}) {
+ &performAddressedReply("that's too long");
+ return 'NOREPLY';
+ }
+
+ &performAddressedReply("okay");
+
+ $count{'Update'}++;
+ &status("update: <$who> \'$lhs\' =$mhs=> \'$rhs\'; was \'$exists\'");
+ &AddModified($lhs,$nuh);
+ &setFactInfo($lhs, "factoid_value", $rhs);
+ } else { # not "also"
+ if ($correction_plausible) { # "no, blah is ..."
+ my $author = &getFactInfo($lhs, "created_by");
+
+ &DEBUG("Update: check: '$author' == '$who' ?");
+
+ if (IsFlag("m") ne "m" and $author !~ /^\Q$who\E\!/i) {
+ &msg($who, "you can't change that factoid.");
+ return 'NOREPLY';
+ }
+
+ &performAddressedReply("okay");
+
+ $count{'Update'}++;
+ &status("update: <$who> \'$lhs\' =$mhs=> \'$rhs\'; was \'$exists\'");
+
+ &delFactoid($lhs);
+ &setFactInfo($lhs,"created_by", $nuh);
+ &setFactInfo($lhs,"created_time", time());
+ &setFactInfo($lhs,"factoid_value", $rhs);
+ } else { # "blah is ..."
+ if ($addressed) {
+ &performStrictReply("...but \002$lhs\002 is already something else...");
+ &status("FAILED update: <$who> \'$lhs\' =$mhs=> \'$rhs\'");
+ }
+ return 'NOREPLY';
+ }
+ }
+ } else { # not exists.
+ &status("enter: <$who> \'$lhs\' =$mhs=> \'$rhs\'");
+ $count{'Update'}++;
+
+ &performAddressedReply("okay");
+
+ &setFactInfo($lhs,"created_by", $nuh);
+ &setFactInfo($lhs,"created_time", time());
+ &setFactInfo($lhs,"factoid_value", $rhs);
+ }
+
+ return "$lhs $mhs $rhs";
+}
+
+1;
--- /dev/null
+#
+# Files.pl: Open and close, read and probably write files.
+# Author: xk <xk@leguin.openprojects.net>
+# Version: v0.2 (2000502)
+# Created: 19991221
+#
+
+if (&IsParam("useStrict")) { use strict; }
+
+# File: Language support.
+sub loadLang {
+ my ($file) = @_;
+ my $langCount = 0;
+ my $replyName;
+
+ if (!open(FILE, $file)) {
+ &ERROR("FAILED loadLang ($file): $!");
+ exit 0;
+ }
+
+ undef %lang; # for rehash.
+
+ while (<FILE>) {
+ 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 lang $file ($langCount items)");
+}
+
+# File: Ignore list.
+sub loadIgnore {
+ my ($file) = @_;
+ %ignoreList = ();
+
+ if (!open(FILE, $file)) {
+ &ERROR("FAILED loadIgnore ($file): $!");
+ return;
+ }
+ &status("Loading ignore list...");
+
+ my $count = 0;
+ while (<FILE>) {
+ chomp;
+ next if /^\s*\#/;
+ next unless /\S/;
+
+ if (/^(\S+)[\t\s]+(\S+)([\t\s]+.*)?$/) {
+ &status(" $2");
+ $ignoreList{$2} = 1;
+ $count++;
+ }
+ }
+ close FILE;
+
+ $file =~ s/^.*\///;
+ &status("Loaded ignore $file ($count masks)");
+}
+
+# File: Irc Servers list.
+sub loadIRCServers {
+ my ($file) = @_;
+ @ircServers = ();
+ %ircPort = ();
+
+ if (!open(FILE, $file)) {
+ &ERROR("FAILED loadIRCServers ($file): $!");
+ exit 0;
+ }
+
+ while (<FILE>) {
+ 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 ircServers $file (". scalar(@ircServers) ." servers)");
+}
+
+# File: User List.
+sub loadUsers {
+ my ($file) = @_;
+ %userList = (); # clear it.
+
+ if (!open(FILE, $file)) {
+ &ERROR("FAILED loadUsers ($file): $!");
+ exit 0;
+ }
+
+ my $userName;
+
+ while (<FILE>) {
+ next if /^\s*$/;
+ next if /^#/;
+
+ if (/^UserEntry\s+(.+?)\s/) {
+ $userName = $1;
+ if (/\s*\{\s*/) {
+ while (<FILE>) {
+ if (/^\s*(\w+)\s+(.+);$/) {
+ my ($opt,$val) = ($1,$2);
+
+ $opt =~ tr/A-Z/a-z/;
+ $val =~ s/\"//g;
+ $val =~ s/\+// if ($opt =~ /^flags$/i);
+
+ if ($opt =~ /^mask$/i) {
+ $userList{$userName}{$opt}{$val} = 1;
+ } else {
+ $userList{$userName}{$opt} = $val;
+ }
+ } elsif (/^\s*\}\s*$/) {
+ last;
+ }
+ }
+ } else {
+ status("parse error: User Entry $userName without right brace");
+ }
+ }
+ }
+ close FILE;
+
+ return unless (&IsParam("VERBOSITY"));
+
+ $file =~ s/^.*\///;
+ &status("Loaded userlist $file (". scalar(keys %userList) ." users)");
+ foreach $userName (keys %userList) {
+ &status(" $userName:");
+ &status(" flags: +$userList{$userName}{'flags'}");
+
+ foreach (keys %{$userList{$userName}{'mask'}}) {
+ status(" hostmask: $_");
+ }
+ }
+}
+
+1;
--- /dev/null
+#
+# Irc.pl: IRC core stuff.
+# Author: xk <xk@leguin.openprojects.net>
+# Version: 20000126
+# NOTE: Based on code by Kevin Lenzo & Patrick Cole (c) 1997
+#
+
+if (&IsParam("useStrict")) { use strict; }
+
+# static scalar variables.
+$mask{ip} = '(\d+)\.(\d+)\.(\d+)\.(\d+)';
+$mask{host} = '[\d\w\_\-\/]+\.[\.\d\w\_\-\/]+';
+$mask{chan} = '[\#\&\+]\S*';
+my $isnick1 = 'a-zA-Z\[\]\{\}\_\`\^\|\\\\';
+my $isnick2 = '0-9\-';
+$mask{nick} = "[$isnick1]{1}[$isnick1$isnick2]*";
+
+sub ircloop {
+ my $error = 0;
+ my $lastrun = 0;
+
+ while (1) {
+ # JUST IN CASE. irq was complaining about this.
+ if ($lastrun == time()) {
+ $error++;
+ sleep 1;
+ next;
+ }
+
+ foreach (@ircServers) {
+ if (!defined $_) {
+ &DEBUG("ircloop: ircServers[x] = NULL.");
+ $lastrun = time();
+ next;
+ }
+ &DEBUG("ircloop: _ => '$_'.");
+ next unless (exists $ircPort{$_});
+
+ my $retval = &irc($_, $ircPort{$_});
+ next unless (defined $retval and $retval == 0);
+ $error++;
+ if ($error % 3 == 0 and $error != 0) {
+ &ERROR("CANNOT connect to this server; next!");
+ next;
+ }
+
+ if ($error >= 3*3) {
+ &ERROR("CANNOT connect to any irc server; stopping.");
+ exit 1;
+ }
+ }
+ }
+}
+
+sub irc {
+ my ($server,$port) = @_;
+
+ my $iaddr = inet_aton($server);
+ my $paddr = sockaddr_in($port, $iaddr);
+ my $proto = getprotobyname('tcp');
+
+ select STDOUT;
+ &status("Connecting to port $port of server $server ...");
+ sleep 3; # lame hack.
+
+ # host->ip.
+ if ($server =~ /\D$/) {
+ my $packed = scalar(gethostbyname($server));
+
+ if (!defined $packed) {
+ &status(" cannot resolve $server.");
+ return 0;
+ }
+
+ my $resolve = inet_ntoa($packed);
+ &status(" resolved to $resolve.");
+ }
+
+ $irc = new Net::IRC;
+
+ $conn = $irc->newconn(
+ Nick => $param{'ircNick'},
+ Server => $server,
+ Port => $port,
+ Ircname => $param{'ircName'},
+ LocalAddr => $param{'ircHost'},
+ );
+
+ if (!defined $conn) {
+ &ERROR("irc: conn was not created!defined!!!");
+ return 1;
+ }
+
+ # clear out hashes before connecting...
+ &clearIRCVars();
+
+ $ident = $param{'ircNick'};
+ ### IRCSTATS.
+ $ircstats{'ConnectTime'} = time();
+ $ircstats{'ConnectCount'}++;
+ $ircstats{'Server'} = "$server:$port";
+
+ # handler stuff.
+ $conn->add_handler('caction', \&on_action);
+ $conn->add_handler('cdcc', \&on_dcc);
+ $conn->add_handler('cping', \&on_ping);
+ $conn->add_handler('crping', \&on_ping_reply);
+ $conn->add_handler('cversion', \&on_version);
+
+ $conn->add_handler('dcc_open', \&on_dcc_open);
+ $conn->add_handler('dcc_close', \&on_dcc_close);
+ $conn->add_handler('chat', \&on_chat);
+ $conn->add_handler('msg', \&on_msg);
+ $conn->add_handler('public', \&on_public);
+ $conn->add_handler('join', \&on_join);
+ $conn->add_handler('part', \&on_part);
+ $conn->add_handler('topic', \&on_topic);
+ $conn->add_handler('invite', \&on_invite);
+ $conn->add_handler('kick', \&on_kick);
+ $conn->add_handler('mode', \&on_mode);
+ $conn->add_handler('nick', \&on_nick);
+ $conn->add_handler('quit', \&on_quit);
+ $conn->add_handler('notice', \&on_notice);
+ $conn->add_handler('whoisuser', \&on_whoisuser);
+ $conn->add_handler('other', \&on_other);
+ $conn->add_global_handler('disconnect', \&on_disconnect);
+ $conn->add_global_handler([251,252,253,254,255], \&on_init);
+### $conn->add_global_handler([251,252,253,254,255,302], \&on_init);
+ $conn->add_global_handler(324, \&on_modeis);
+ $conn->add_global_handler(333, \&on_topicinfo);
+ $conn->add_global_handler(352, \&on_who);
+ $conn->add_global_handler(353, \&on_names);
+ $conn->add_global_handler(366, \&on_endofnames);
+ $conn->add_global_handler(376, \&on_endofmotd);
+ $conn->add_global_handler(433, \&on_nick_taken);
+ $conn->add_global_handler(439, \&on_targettoofast);
+ # end of handler stuff.
+
+ $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) = @_;
+ if (!defined $msg or $msg eq "NOREPLY") {
+ $msg ||= "NULL";
+ &DEBUG("say: msg == $msg.");
+ return;
+ }
+
+ if ($msg eq $last{say} and length($msg) > 256) {
+ &status("say: detected repeated message; skipping.");
+ return;
+ }
+ $last{say} = $msg;
+
+ &status("</$talkchannel> $msg");
+ if (&whatInterface() =~ /IRC/) {
+ $msg = "zero" if ($msg =~ /^0+$/);
+
+ $conn->privmsg($talkchannel, $msg);
+ }
+}
+
+sub msg {
+ my ($nick, $msg) = @_;
+ if (!defined $nick) {
+ &ERROR("msg: nick == NULL.");
+ return;
+ }
+
+ if (!defined $msg or $msg eq "NOREPLY") {
+ $msg ||= "NULL";
+ &DEBUG("msg: msg == $msg.");
+ return;
+ }
+
+ if ($msg eq $last{msg} and length($msg) > 256) {
+ &status("msg: detected repeated message; skipping.");
+ return;
+ }
+ $last{msg} = $msg;
+
+ &status(">$nick< $msg");
+ $conn->privmsg($nick, $msg) if (&whatInterface() =~ /IRC/);
+}
+
+# Usage: &action(nick || chan, txt);
+sub action {
+ my ($target, $txt) = @_;
+ if (!defined $txt) {
+ &DEBUG("action: txt == NULL.");
+ return;
+ }
+
+ my $rawout = "PRIVMSG $target :\001ACTION $txt\001";
+ if (length $rawout > 510) {
+ &status("action: txt too long; truncating.");
+
+ chop($rawout) while (length($rawout) > 510);
+ $rawout .= "\001";
+ }
+
+ &status("* $ident/$target $txt");
+ rawout($rawout);
+}
+
+# Usage: &action(nick || chan, txt);
+sub notice{
+ my ($target, $txt) = @_;
+ if (!defined $txt) {
+ &DEBUG("action: txt == NULL.");
+ return;
+ }
+
+ &status("-$target- $txt");
+
+ $conn->notice($target, $txt);
+}
+
+
+sub DCCBroadcast {
+ my ($txt) = @_;
+
+ foreach (keys %{$dcc{'CHAT'}}) {
+ $conn->privmsg($dcc{'CHAT'}{$_}, $txt);
+ }
+}
+
+##########
+### perform commands.
+###
+
+# Usage: &performReply($reply);
+sub performReply {
+ my ($reply) = @_;
+ $reply =~ /([\.\?\s]+)$/;
+
+ &checkMsgType($reply);
+
+ if ($msgType eq 'public') {
+ if (rand() < 0.5) {
+ $reply = "$orig{who}: ".$reply;
+ } else {
+ $reply = "$reply, ".$orig{who};
+ }
+ &say($reply);
+ } elsif ($msgType eq 'private') {
+ if (rand() < 0.5) {
+ $reply = $reply;
+ } else {
+ $reply = "$reply, ".$orig{who};
+ }
+ &msg($who, $reply);
+ } elsif ($msgType eq 'chat') {
+ &DEBUG("pR: chat: reply => '$reply'.");
+ &DEBUG("pR: chat: sock => '$dcc{'CHAT'}{$nick}'.");
+ &DEBUG("pR: chat: sock => '$dcc{'CHAT'}{$who}'.");
+ } else {
+ &ERROR("PR: msgType invalid? ($msgType).");
+ }
+}
+
+# ...
+sub performAddressedReply {
+ return unless ($addressed);
+ &performReply(@_);
+}
+
+# Usage: &performStrictReply($reply);
+sub performStrictReply {
+ my ($reply) = @_;
+
+ &checkMsgType($reply);
+
+ if ($msgType eq 'private') {
+ &msg($who, $reply);
+ } elsif ($msgType eq 'public') {
+ &say($reply);
+ } elsif ($msgType eq 'chat') {
+ if (!exists $dcc{'CHAT'}{$who}) {
+ &WARN("pSR: dcc{'CHAT'}{$who} does not exist.");
+ return;
+ }
+ $conn->privmsg($dcc{'CHAT'}{$who}, $reply);
+ } else {
+ &ERROR("pSR: msgType invalid? ($msgType).");
+ }
+
+ return '';
+}
+
+sub joinchan {
+ my ($chankey) = @_;
+ my $chan = lc $chankey;
+
+ if ($chankey =~ s/^($mask{chan}),\S+/ /) {
+ $chan = lc $1;
+ }
+
+ &status("joining $b_blue$chan$ob");
+
+ if (&validChan($chan)) {
+ &status("join: already on $chan");
+ } else {
+ $conn->join($chan);
+ }
+}
+
+sub part {
+ my $chan;
+
+ foreach $chan (@_) {
+ next if ($chan eq "");
+ $chan =~ tr/A-Z/a-z/; # lowercase.
+
+ &status("parting $chan");
+ if (!&validChan($chan)) {
+ &status("part: not on $chan");
+ next;
+ }
+
+ rawout("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;
+ }
+
+ 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);
+
+ 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}{$ident}) {
+ &status("Kick: do not have ops on $chan :(");
+ next;
+ }
+
+ &status("Kicking $nick from $chan.");
+ if ($msg eq "") {
+ &rawout("KICK $chan $nick");
+ } else {
+ &rawout("KICK $chan $nick :$msg");
+ }
+ }
+}
+
+sub ban {
+ my ($mask,$chan) = @_;
+ my (@chans) = ($chan eq "") ? (keys %channels) : lc($chan);
+
+ if ($chan ne "" and &validChan($chan) == 0) {
+ &ERROR("ban: invalid channel $chan.");
+ return;
+ }
+
+ $nick =~ tr/A-Z/a-z/;
+
+ foreach $chan (@chans) {
+ if (!&IsNickInChan($nick,$chan) and scalar @chans == 1) {
+ &status("Ban: $nick is not on $chan.");
+ next;
+ }
+
+ if (!exists $channels{$chan}{o}{$ident}) {
+ &status("Ban: do not have ops on $chan :(");
+ next;
+ }
+
+ &status("Banning $mask from $chan.");
+ &rawout("MODE $chan +b $mask");
+ }
+}
+
+sub quit {
+ my ($quitmsg) = @_;
+ &status("QUIT $param{'ircNick'} has quit IRC ($quitmsg)");
+ $conn->quit($quitmsg);
+}
+
+sub nick {
+ my ($nick) = @_;
+
+ if ($nick =~ /^$mask{nick}$/) {
+ rawout("NICK ".$nick);
+ return 1;
+ }
+
+ return 0;
+}
+
+sub invite {
+ my($who, $chan) = @_;
+ rawout("INVITE $who $chan");
+}
+
+
+##########
+# Channel related functions...
+#
+
+# Usage: &joinNextChan();
+sub joinNextChan {
+ if (scalar @joinchan) {
+ my $chan = shift @joinchan;
+ &joinchan($chan);
+
+ if (my $i = scalar @joinchan) {
+ &status("joinNextChan: $i chans to join.");
+ }
+ }
+}
+
+# Usage: &GetNickInChans($nick,$chan);
+sub GetNickInChans {
+ my ($nick) = @_;
+ my @array;
+
+ foreach (keys %channels) {
+ next unless (grep /^\Q$nick\E$/i, keys %{$channels{$_}{''}});
+ push(@array, $_);
+ }
+
+ return @array;
+}
+
+sub IsNickInChan {
+ my ($nick,$chan) = @_;
+
+ $chan =~ tr/A-Z/a-z/; # not lowercase unfortunately.
+
+ if (&validChan($chan) == 0) {
+ &ERROR("INIC: invalid channel $chan.");
+ return 0;
+ }
+
+ if (grep /^\Q$nick\E$/i, keys %{$channels{$chan}{''}}) {
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+sub IsNickInAnyChan {
+ my ($nick) = @_;
+
+ foreach $chan (keys %channels) {
+ next unless (grep /^\Q$nick\E$/i, keys %{$channels{$chan}{''}});
+ return 1;
+ }
+ return 0;
+}
+
+# Usage: &validChan($chan);
+sub validChan {
+ my ($chan) = @_;
+
+ if (lc $chan ne $chan) {
+ &WARN("validChan: lc chan != chan. ($chan); fixing.");
+ $chan =~ tr/A-Z/a-z/;
+ }
+
+ if (exists $channels{$chan}) {
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+###
+# Usage: &DeleteUserInfo($nick,@chans);
+sub DeleteUserInfo {
+ 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 {
+ &DEBUG("clearIRCVars() called!");
+ %channels = ();
+ @joinchan = split /[\t\s]+/, $param{'join_channels'};
+}
+
+sub makeChanList {
+ my ($str) = @_;
+ my $inverse = 0;
+ my @chans;
+
+ if ($str eq "ALL") {
+ return(keys %channels);
+ } elsif ($str =~ s/^ALL but //i) {
+ @chans = keys %channels;
+ foreach (split /[\s\t\,]+/, lc $str) {
+ @chans = grep !/^$_$/, @chans;
+ }
+ } else {
+ foreach (split /[\s\t\,]+/, lc $str) {
+ next unless (&validChan($_));
+ push(@chans, $_);
+ }
+ }
+
+ @chans;
+}
+
+sub closeDCC {
+ foreach $type (keys %dcc) {
+ foreach (keys %{$dcc{$type}}) {
+ &DEBUG("closing DCC $type to $_ (FIXME).");
+### $irc->removeconn($dcc{$type}{$_});
+ }
+ }
+}
+
+1;
--- /dev/null
+#
+# IrcHooks.pl: IRC Hooks stuff.
+# Author: xk <xk@leguin.openprojects.net>
+# Version: 20000126
+# NOTE: Based on code by Kevin Lenzo & Patrick Cole (c) 1997
+#
+
+if (&IsParam("useStrict")) { use strict; }
+
+my $nickserv = 0;
+
+# GENERIC. TO COPY.
+sub on_generic {
+ my ($self, $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 {
+ my ($self, $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 {
+ my ($self, $event) = @_;
+ my $msg = ($event->args)[0];
+ my $sock = ($event->to)[0];
+ my $nick = $event->nick();
+
+ if (!exists $nuh{lc $nick}) {
+ &DEBUG("chat: nuh{$nick} doesn't exist; hrm should retry.");
+ return;
+ } else {
+ $message = $msg;
+ $who = lc $nick;
+ $orig{who} = $nick;
+ $orig{message} = $msg;
+ $nuh = $nuh{$who};
+ $uh = (split /\!/, $nuh)[1];
+ $addressed = 1;
+ $msgType = 'chat';
+ }
+
+ if (!exists $dcc{'CHAT'}{$nick}) {
+ my $userHandle = &verifyUser($who, $nuh);
+ my $crypto = $userList{$userHandle}{'pass'};
+ my $success = 0;
+
+ if (!defined $crypto) {
+ &DEBUG("chat: no pass required.");
+ $success++;
+ } elsif (&ckpasswd($msg, $crypto)) {
+ $self->privmsg($sock,"Authorized.");
+ $self->privmsg($sock,"I'll respond as if through /msg and addressed in public. Addition to that, access to 'user' commands will be allowed, like 'die' and 'jump'.");
+ # hrm... it's stupid to ask for factoids _within_ dcc chat.
+ # perhaps it should be default to commands, especially
+ # commands only authorized through DCC CHAT.
+ &status("DCC CHAT: passwd is ok.");
+ $success++;
+ } else {
+ &status("DCC CHAT: incorrect pass; closing connection.");
+ &DEBUG("chat: sock => '$sock'.");
+### $sock->close();
+ &DEBUG("chat: after closing sock. FIXME");
+ ### BUG: close seizes bot. why?
+ }
+
+ if ($success) {
+ &status("DCC CHAT: user $nick is here!");
+ $dcc{'CHAT'}{$nick} = $sock;
+ &DCCBroadcast("$nick ($uh) has joined the chat arena.");
+ }
+
+ return;
+ }
+
+
+ $userHandle = &verifyUser($who, $nuh);
+ &status("$b_red=$b_cyan$who$b_red=$ob $message");
+ if ($message =~ s/^\.//) { # dcc chat commands.
+ ### TODO: make use of &Forker(); here?
+ &loadMyModule($myModules{'ircdcc'});
+ return 'NOREPLY from userD' if (&userDCC() 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';
+}
+
+sub on_endofmotd {
+ my ($self) = @_;
+
+ if (&IsParam("wingate")) {
+ my $file = "$infobot_base_dir/$param{'ircUser'}.wingate";
+ open(IN, $file);
+ while (<IN>) {
+ chop;
+ next unless (/^(\S+)\*$/);
+ push(@wingateBad, $_);
+ }
+ close IN;
+ }
+
+ ### TODO: move this to end of &joinNextChan()?
+ if ($firsttime) {
+ &DEBUG("on_EOM: calling sS in 60s.");
+ $conn->schedule(60, \&setupSchedulers, "");
+ $firsttime = 0;
+ }
+
+ if (&IsParam("ircUMode")) {
+ &status("Changing user modes to $param{'ircUMode'}.");
+ &rawout("MODE $ident $param{'ircUMode'}");
+ }
+
+ &status("End of motd. Now lets join some channels...");
+ if (!scalar @joinchan) {
+ &WARN("joinchan array is empty!!!");
+ @joinchan = split /[\t\s]+/, $param{'join_channels'};
+ }
+
+ &joinNextChan();
+}
+
+sub on_dcc {
+ my ($self, $event) = @_;
+ my $type = uc( ($event->args)[1] );
+ my $nick = $event->nick();
+
+ # pity Net::IRC doesn't store nuh. Here's a hack :)
+ $self->whois($nick);
+
+ if ($type eq 'SEND') {
+ # incoming DCC SEND. we're receiving a file.
+ $self->new_get($event, \*FH);
+ } elsif ($type eq 'CHAT') {
+ $self->new_chat($event);
+ } else {
+ &status("${b_green}DCC $type$ob unknown ...");
+ }
+}
+
+sub on_dcc_close {
+ my ($self, $event) = @_;
+ my $nick = $event->nick();
+ my $sock = ($event->to)[0];
+
+ &DEBUG("dcc_close: nick => '$nick'.");
+
+ if (exists $dcc{'SEND'}{$nick} and -f "temp/$nick.txt") {
+ &status("${b_green}DCC SEND$ob close from $b_cyan$nick$ob");
+
+ &status("dcc_close: purging $nick.txt from Debian.pl");
+ unlink "temp/$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};
+ } else {
+ &status("${b_green}DCC$ob UNKNOWN close from $b_cyan$nick$ob");
+ }
+}
+
+sub on_dcc_open {
+ my ($self, $event) = @_;
+ my $type = uc( ($event->args)[0] );
+ my $nick = $event->nick();
+ my $sock = ($event->to)[0];
+ $msgType = 'chat';
+
+ if ($type eq 'SEND') {
+ &status("${b_green}DCC lGET$ob established with $b_cyan$nick$ob");
+ } elsif ($type eq 'CHAT') {
+ &status("${b_green}DCC CHAT$ob established with $b_cyan$nick$ob ($nuh{$nick})");
+ my $userHandle = &verifyUser($nick, $nuh{lc $nick});
+ my $crypto = $userList{$userHandle}{'pass'};
+ if (defined $crypto) {
+ $self->privmsg($sock,"Enter Password, $userHandle.");
+ } else {
+ $self->privmsg($sock,"Welcome to blootbot DCC CHAT interface, $userHandle.");
+ }
+ } else {
+ &status("${b_green}DCC $type$ob unknown ...");
+ }
+}
+
+sub on_disconnect {
+ my ($self, $event) = @_;
+ my $from = $event->from();
+ my $what = ($event->args)[0];
+
+ &status("disconnect from $from ($what).");
+ $ircstats{'DisconnectReason'} = $what;
+
+ # clear any variables on reconnection.
+ $nickserv = 0;
+
+ &clearIRCVars();
+
+ if (!$self->connect()) {
+ &WARN("not connected? help me. ircCheck() should reconnect me");
+ }
+}
+
+sub on_endofnames {
+ my ($self, $event) = @_;
+ my $chan = ($event->args)[1];
+
+ if (exists $jointime{$chan}) {
+ my $delta_time = sprintf("%.03f", &gettimeofday() - $jointime{$chan});
+ $delta_time = 0 if ($delta_time < 0);
+
+ &status("$b_blue$chan$ob: sync in ${delta_time}s.");
+ }
+
+ rawout("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]");
+
+ if (scalar @joinchan) { # remaining channels to join.
+ &joinNextChan();
+ } else {
+ ### chanserv support.
+ ### TODO: what if we rejoin a channel.. need to set a var that
+ ### we've done the request-for-ops-on-join.
+ return unless (&IsParam("chanServ_ops"));
+ return unless ($nickserv);
+
+ my @chans = split(/[\s\t]+/, $param{'chanServ_ops'});
+
+ foreach $chan (keys %channels) {
+ next unless (grep /^$chan$/i, @chans);
+
+ if (!exists $channels{$chan}{'o'}{$ident}) {
+ &status("ChanServ ==> Requesting ops for $chan.");
+ rawout("PRIVMSG ChanServ :OP $chan $ident");
+ }
+ }
+ }
+
+}
+
+sub on_init {
+ my ($self, $event) = @_;
+ my (@args) = ($event->args);
+ shift @args;
+
+ &status("@args");
+}
+
+sub on_invite {
+ my ($self, $event) = @_;
+ my $chan = ($event->args)[0];
+ my $nick = $event->nick;
+
+ &DEBUG("on_invite: chan => '$chan', nick => '$nick'.");
+
+ # chan + possible_key.
+ ### do we need to know the key if we're invited???
+ ### grep the channel list?
+ foreach (split /[\s\t]+/, $param{'join_channels'}) {
+ next unless /^\Q$chan\E(,\S+)?$/i;
+ s/,/ /;
+
+ next if ($nick =~ /^\Q$ident\E$/);
+ if (&validChan($chan)) {
+ &msg($who, "i'm already in \002$chan\002.");
+ next;
+ }
+
+ &status("invited to $b_blue$_$ob by $b_cyan$who$ob");
+ &joinchan($self, $_);
+ }
+}
+
+sub on_join {
+ my ($self, $event) = @_;
+ my ($user,$host) = split(/\@/, $event->userhost);
+ $chan = lc( ($event->to)[0] ); # CASING!!!!
+ $who = $event->nick();
+
+ $chanstats{$chan}{'Join'}++;
+ $userstats{lc $who}{'Join'} = time() if (&IsParam("seenStats"));
+
+ # netjoin detection.
+ my $netsplit = 0;
+ if (exists $netsplit{lc $who}) {
+ delete $netsplit{lc $who};
+ $netsplit = 1;
+ }
+
+ # 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{lc $who} = $who."!".$user."\@".$host unless (exists $nuh{lc $who});
+
+ ### ROOTWARN:
+ &rootWarn($who,$user,$host,$chan)
+ if (&IsParam("rootWarn") &&
+ $user =~ /^r(oo|ew|00)t$/i &&
+ $channels{$chan}{'o'}{$ident});
+
+ # used to determine sync time.
+ if ($who =~ /^$ident$/i) {
+ if (defined( my $whojoin = $joinverb{$chan} )) {
+ &msg($chan, "Okay, I'm here. (courtesy of $whojoin)");
+ delete $joinverb{$chan};
+ }
+
+ ### TODO: move this to &joinchan()?
+ $jointime{$chan} = &gettimeofday();
+ rawout("WHO $chan");
+ } else {
+ ### TODO: this may go wild on a netjoin :)
+ ### WINGATE:
+ &wingateCheck();
+ }
+}
+
+sub on_kick {
+ my ($self, $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");
+
+ $chanstats{$chan}{'Kick'}++;
+
+ if ($kickee eq $ident) {
+ &clearChanVars($chan);
+
+ &status("SELF attempting to rejoin lost channel $chan");
+ &joinchan($chan);
+ } else {
+ &DeleteUserInfo($kickee,$chan);
+ }
+}
+
+sub on_mode {
+ my ($self, $event) = @_;
+ my ($user, $host) = split(/\@/, $event->userhost);
+ my @args = $event->args();
+ my $nick = $event->nick();
+ my $chan = ($event->to)[0];
+
+ $args[0] =~ s/\s$//;
+
+ 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($chan, @args);
+ }
+}
+
+sub on_modeis {
+ my ($self, $event) = @_;
+ my $nick = $event->nick();
+ my ($myself,$chan,@args) = $event->args();
+
+ &hookMode(lc $chan, @args); # CASING.
+}
+
+sub on_msg {
+ my ($self, $event) = @_;
+ my $nick = $event->nick;
+ my $chan = lc ( ($event->to)[0] ); # CASING.
+ my $msg = ($event->args)[0];
+
+ ($user,$host) = split(/\@/, $event->userhost);
+ $uh = $event->userhost();
+ $nuh = $nick."!".$uh;
+
+ &hookMsg('private', $chan, $nick, $msg);
+}
+
+sub on_names {
+ my ($self, $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 {
+ my ($self, $event) = @_;
+ my $nick = $event->nick();
+ my $newnick = ($event->args)[0];
+
+ 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};
+ }
+ }
+ &DeleteUserInfo($nick,keys %channels);
+ $nuh{lc $newnick} = $nuh{lc $nick};
+ delete $nuh{lc $nick};
+
+ # successful self-nick change.
+ if ($nick eq $ident) {
+ &status(">>> I materialized into $b_green$newnick$ob from $nick");
+ $ident = $newnick;
+ } else {
+ &status(">>> $b_cyan$nick$ob materializes into $b_green$newnick$ob");
+ }
+}
+
+sub on_nick_taken {
+ my ($self) = @_;
+ my $nick = $self->nick;
+ my $newnick = substr($nick,0,8).int(rand(10));
+
+ &DEBUG("on_nick_taken: changing nick to $newnick.");
+ $self->nick($newnick);
+ $ident = $newnick;
+}
+
+sub on_notice {
+ my ($self, $event) = @_;
+ my $nick = $event->nick();
+ my $chan = ($event->to)[0];
+ my $args = ($event->args)[0];
+
+ if ($nick =~ /^NickServ$/i) { # nickserv.
+ &status("NickServ: <== '$args'");
+
+ if ($args =~ /^This nickname is registered/i) {
+ &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) {
+ $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 {
+ my ($self, $event) = @_;
+ my $chan = ($event->to)[0];
+ my $nick = $event->nick;
+
+ &status("!!! other called.");
+ &status("!!! $event->args");
+}
+
+sub on_part {
+ my ($self, $event) = @_;
+ my $chan = lc( ($event->to)[0] ); # CASING!!!
+ my $nick = $event->nick;
+ my $userhost = $event->userhost;
+
+ $chanstats{$chan}{'Part'}++;
+ &DeleteUserInfo($nick,$chan);
+ &clearChanVars($chan) if ($nick eq $ident);
+ if (!&IsNickInAnyChan($nick) and &IsParam("seenStats")) {
+ delete $userstats{lc $nick};
+ }
+
+ &status(">>> part/$b_blue$chan$ob $b_cyan$nick$ob $b_yellow($ob$userhost$b_yellow)$ob");
+}
+
+sub on_ping {
+ my ($self, $event) = @_;
+ my $nick = $event->nick;
+
+ $self->ctcp_reply($nick, join(' ', ($event->args)));
+ &status(">>> ${b_green}CTCP PING$ob request from $b_cyan$nick$ob received.");
+}
+
+sub on_ping_reply {
+ my ($self, $event) = @_;
+ my $nick = $event->nick;
+ my $lag = time() - ($event->args)[1];
+
+ &status(">>> ${b_green}CTCP PING$ob reply from $b_cyan$nick$ob: $lag sec.");
+}
+
+sub on_public {
+ my ($self, $event) = @_;
+ my $msg = ($event->args)[0];
+ my $chan = lc( ($event->to)[0] ); # CASING.
+ my $nick = $event->nick;
+ $uh = $event->userhost();
+ $nuh = $nick."!".$uh;
+ ($user,$host) = split(/\@/, $uh);
+
+ ### DEBUGGING.
+ if ($statcount < 200) {
+ 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}{$_} ...");
+ }
+ }
+ }
+ }
+
+
+ $msgtime = time();
+ $lastWho{$chan} = $nick;
+ ### TODO: use $nick or lc $nick?
+ if (&IsParam("seenStats")) {
+ $userstats{lc $nick}{'Count'}++;
+ $userstats{lc $nick}{'Time'} = time();
+ }
+
+# if (&IsParam("hehCounter")) {
+# #...
+# }
+
+ &hookMsg('public', $chan, $nick, $msg);
+ $chanstats{$chan}{'PublicMsg'}++;
+}
+
+sub on_quit {
+ my ($self, $event) = @_;
+ my $nick = $event->nick();
+ my $reason = ($event->args)[0];
+
+ foreach (keys %channels) {
+ # fixes inconsistent chanstats bug #1.
+ next unless (&IsNickInChan($nick,$_));
+ $chanstats{$_}{'SignOff'}++;
+ }
+ &DeleteUserInfo($nick, keys %channels);
+ if (exists $nuh{lc $nick}) {
+ delete $nuh{lc $nick};
+ } else {
+ &DEBUG("on_quit: nuh{lc $nick} does not exist! FIXME");
+ }
+ delete $userstats{lc $nick} if (&IsParam("seenStats"));
+
+ # should fix chanstats inconsistencies bug #2.
+ if ($reason=~/^($mask{host})\s($mask{host})$/) { # netsplit.
+ $reason = "NETSPLIT: $1 <=> $2";
+
+ $netsplit{lc $nick} = time();
+ if (!exists $netsplitservers{$1}{$2}) {
+ &status("netsplit detected between $1 and $2.");
+ $netsplitservers{$1}{$2} = time();
+ }
+ }
+
+ &status(">>> $b_cyan$nick$ob has signed off IRC $b_red($ob$reason$b_red)$ob");
+ if ($nick =~ /^\Q$ident\E$/) {
+ &DEBUG("!!! THIS SHOULD NEVER HAPPEN. FIXME HOPEFULLY");
+ }
+ if ($nick !~ /^\Q$ident\E$/ and $nick =~ /^\Q$param{'ircNick'}\E$/i) {
+ &status("own nickname became free; changing.");
+ &nick($param{'ircNick'});
+ }
+}
+
+sub on_targettoofast {
+ my ($self, $event) = @_;
+ my $nick = $event->nick();
+ my $chan = ($event->to)[0];
+
+ &DEBUG("on_targettoofast: nick => '$nick'.");
+ &DEBUG("on_targettoofast: chan => '$chan'.");
+
+ foreach ($event->args) {
+ &DEBUG("on_targettoofast: args => '$_'.");
+ }
+
+### .* wait (\d+) second/) {
+ &status($msg);
+ my $sleep = $3 + 10;
+
+ &status("going to sleep for $sleep...");
+ sleep $sleep;
+ &joinNextChan();
+### }
+}
+
+sub on_topic {
+ my ($self, $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 and &IsParam("topic") == 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 (&IsParam("topic")) {
+ $topic{$chan}{'Current'} = $topic;
+ &topicAddHistory($chan,$topic);
+ }
+
+ $topic = &fixString($topic, 1);
+ &status(">>> topic/$b_blue$chan$ob is $topic");
+ }
+}
+
+sub on_topicinfo {
+ my ($self, $event) = @_;
+ my ($myself,$chan,$setby,$time) = $event->args();
+
+ my $timestr;
+ if (time() - $time > 60*60*24) {
+ $timestr = "at ". localtime $time;
+ } else {
+ $timestr = &Time2String(time() - $time) ." ago";
+ }
+
+ &status(">>> set by $b_cyan$setby$ob $timestr");
+}
+
+sub on_version {
+ my ($self, $event) = @_;
+ my $nick = $event->nick;
+
+ &status(">>> ${b_green}CTCP VERSION$ob request from $b_cyan$nick$ob");
+ $self->ctcp_reply($nick, "VERSION $infobot_version");
+}
+
+sub on_who {
+ my ($self, $event) = @_;
+ my @args = $event->args;
+
+ $nuh{lc $args[5]} = $args[5]."!".$args[2]."\@".$args[3];
+}
+
+sub on_whoisuser {
+ my ($self, $event) = @_;
+ my @args = $event->args;
+
+ $nuh{lc $args[1]} = $args[1]."!".$args[2]."\@".$args[3];
+}
+
+#######################################################################
+####### IRC HOOK HELPERS IRC HOOK HELPERS IRC HOOK HELPERS ########
+#######################################################################
+
+#####
+# Usage: &hookMode($chan, $modes, @targets);
+sub hookMode {
+ my ($chan, $modes, @targets) = @_;
+ my $parity = 0;
+
+ $chan = lc $chan; # !!!.
+
+ 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 =~ /[ov]/) {
+ $channels{$chan}{$mode}{$target}++ if $parity;
+ delete $channels{$chan}{$mode}{$target} if !$parity;
+ }
+
+ 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.
+
+ &showProc();
+
+ # addressing.
+ if ($msgType =~ /private/) {
+ # private messages.
+ $addressed = 1;
+ } else {
+ # public messages.
+ # addressing revamped by the xk.
+ ### below needs to be fixed...
+ if (&IsParam("addressCharacter")) {
+ if ($message =~ s/^$param{'addressCharacter'}//) {
+ $addrchar = 1;
+ $addressed = 1;
+ }
+ }
+
+ if ($message =~ /^($mask{nick})([\;\:\>\, ]+) */) {
+ my $newmessage = $';
+ if ($1 =~ /^\Q$ident\E$/i) {
+ $message = $newmessage;
+ $addressed = 1;
+ } else {
+ # ignore messages addressed to other people or unaddressed.
+ $skipmessage++ if ($2 ne "" and $2 !~ /^ /);
+ }
+ }
+ }
+
+ # Determine floodwho.
+ if ($msgType =~ /public/i) { # public.
+ $floodwho = lc $chan;
+ } elsif ($msgType =~ /private/i) { # private.
+ $floodwho = lc $who;
+ } else { # dcc?
+ &DEBUG("FIXME: floodwho = ???");
+ }
+
+ my ($count, $interval) = split(/:/, $param{'floodRepeat'} || "2:10");
+
+ # flood repeat protection.
+ if ($addressed) {
+ my $time = $flood{$floodwho}{$message};
+
+ if (defined $time and (time - $time < $interval)) {
+ ### public != personal who so the below is kind of pointless.
+ my @who;
+ foreach (keys %flood) {
+ next if (/^\Q$floodwho\E$/ or /^\Q$chan\E$/);
+ push(@who, grep /^\Q$message\E$/i, keys %{$flood{$_}});
+ }
+ if (scalar @who) {
+ &msg($who, "you already said what ".join(@who)." have said.");
+ } else {
+ &msg($who,"Someone 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 me");
+ } else {
+ &status("$b_cyan$who$ob is addressing me");
+ }
+
+ $flood{$floodwho}{$message} = time();
+ }
+
+ ($count, $interval) = split(/:/, $param{'floodMessages'} || "5:30");
+ # 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) {
+ &msg($who,"overflow of messages ($i > $count)");
+ &status("FLOOD overflow detected from $floodwho; ignoring");
+
+ my $expire = $param{'ignoreAutoExpire'} || 5;
+ $ignoreList{"*!$uh"} = time() + ($expire * 60);
+ return;
+ }
+
+ $flood{$floodwho}{$message} = time();
+ }
+
+ # public.
+ if ($msgType =~ /public/i) {
+ $talkchannel = $chan;
+ &status("<$orig{who}/$chan> $orig{message}");
+ }
+
+ # private.
+ if ($msgType =~ /private/i) {
+ &status("[$orig{who}] $orig{message}");
+ }
+
+ return if ($skipmessage);
+ return unless (&IsParam("minVolunteerLength") or $addressed);
+
+ local $ignore = 0;
+ foreach (keys %ignoreList) {
+ my $ignoreRE = $_;
+ my @parts = split /\*/, "a${ignoreRE}a";
+ my $recast = join '\S*', map quotemeta($_), @parts;
+ $recast =~ s/^a(.*)a$/$1/;
+ if ($nuh =~ /^$recast$/) {
+ $ignore++;
+ last;
+ }
+ }
+
+ if (defined $nuh) {
+ $userHandle = &verifyUser($who, $nuh);
+ } else {
+ &DEBUG("hookMsg: 'nuh' not defined?");
+ }
+
+### For extra debugging purposes...
+ if ($_ = &process()) {
+# &DEBUG("IrcHooks: process returned '$_'.");
+ }
+
+ return;
+}
+
+1;
--- /dev/null
+#
+# ProcessExtra.pl: Extensions to Process.pl
+# Author: xk <xk@leguin.openprojects.net>
+# Version: v0.3 (20000707)
+# Created: 20000117
+#
+
+if (&IsParam("useStrict")) { use strict; }
+
+sub setupSchedulers {
+ &VERB("Starting schedulers...",2);
+
+ # ONCE OFF.
+
+ # REPETITIVE.
+ &uptimeCycle(1) if (&IsParam("uptime"));
+ &randomQuote(1) if (&IsParam("randomQuote"));
+ &randomFactoid(1) if (&IsParam("randomFactoid"));
+ &logCycle(1) if ($loggingstatus and &IsParam("logFile") and &IsParam("maxLogSize"));
+ &limitCheck(1) if (&IsParam("limitcheck"));
+ &netsplitCheck(1); # mandatory
+ &floodCycle(1); # mandatory
+ &seenFlush(1) if (&IsParam("seen") and &IsParam("seenFlushInterval"));
+ &leakCheck(1); # mandatory
+ &ignoreListCheck(1);# mandatory
+ &seenFlushOld(1) if (&IsParam("seen"));
+ &ircCheck(1); # mandatory
+ &shmFlush(1); # mandatory
+ &slashdotCycle(1) if (&IsParam("slashdot") and &IsParam("slashdotAnnounce"));
+ &freshmeatCycle(1) if (&IsParam("freshmeat") and &IsParam("freshmeatAnnounce"));
+ &kernelCycle(1) if (&IsParam("kernel") and &IsParam("kernelAnnounce"));
+ &wingateWriteFile(1) if (&IsParam("wingate"));
+}
+
+sub ScheduleThis {
+ my ($interval, $codename, @args) = @_;
+ my $waittime = &getRandomInt($interval);
+
+ &VERB("Scheduling \&$codename() for ".&Time2String($waittime),3);
+ $conn->schedule($waittime, \&$codename, @args);
+}
+
+sub randomQuote {
+ my $line = &getRandomLineFromFile($infobot_misc_dir. "/infobot.randtext");
+ if (!defined $line) {
+ &ERROR("random Quote: weird error?");
+ return;
+ }
+
+ my @channels = split(/[\s\t]+/, lc $param{'randomQuoteChannels'});
+ @channels = keys(%channels) unless (scalar @channels);
+
+ my $good = 0;
+ foreach (@channels) {
+ next unless (&validChan($_));
+
+ &status("sending random Quote to $_.");
+ &action($_, "Ponders: ".$line);
+ $good++;
+ }
+
+ if (!$good) {
+ &WARN("randomQuote: no valid channels?");
+ return;
+ }
+
+ my $interval = $param{'randomQuoteInterval'} || 60;
+ &ScheduleThis($interval, "randomQuote") if (@_);
+}
+
+sub randomFactoid {
+ my ($key,$val);
+ my $error = 0;
+ while (1) {
+ ($key,$val) = &randKey("factoids","factoid_key,factoid_value");
+### $val =~ tr/^[A-Z]/[a-z]/; # blah is Good => blah is good.
+ last if ($val !~ /^</);
+ $error++;
+ if ($error == 5) {
+ &ERROR("rF: tried 5 times but failed.");
+ return;
+ }
+ }
+
+ my @channels = split(/[\s\t]+/, lc $param{'randomFactoidChannels'});
+ @channels = keys(%channels) unless (scalar @channels);
+
+ my $good = 0;
+ foreach (@channels) {
+ next unless (&validChan($_));
+
+ &status("sending random Factoid to $_.");
+### &msg($_, "$key is $val");
+ &action($_, "Thinks: \037$key\037 is $val");
+ ### FIXME: Use &getReply() on above to format factoid properly?
+ $good++;
+ }
+
+ if (!$good) {
+ &WARN("randomFactoid: no valid channels?");
+ return;
+ }
+
+ my $interval = $param{'randomFactoidInterval'} || 60;
+ &ScheduleThis($interval, "randomFactoid") if (@_);
+}
+
+sub logCycle {
+ if ( -s $file{log} > $param{'maxLogSize'}) {
+ my $date = sprintf("%04d%02d%02d", (localtime)[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();
+ system("/bin/mv '$param{'logfile'}' '$file{log}'");
+ &compress($file{log});
+ &openLog();
+ &status("cycling log file.");
+ }
+
+ &ScheduleThis(60, "logCycle") if (@_);
+}
+
+sub seenFlushOld {
+ my $max_time = $param{'seenMaxDays'}*60*60*24;
+ my $delete = 0;
+
+ if ($param{'DBType'} =~ /^pg|postgres|mysql/i) {
+ my $query = "SELECT nick,time FROM seen GROUP BY nick HAVING UNIX_TIMESTAMP() - time > $max_time";
+ my $sth = $dbh->prepare($query);
+ $sth->execute;
+
+ while (my @row = $sth->fetchrow_array) {
+ my ($nick,$time) = @row;
+
+ &dbDel("seen","nick",$nick);
+ $delete++;
+ }
+ $sth->finish;
+ } elsif ($param{'DBType'} =~ /^dbm/i) {
+ my $time = time();
+
+ foreach (keys %seen) {
+ my $delta_time = $time - &dbGet("seen", "NULL", $_, "time");
+ next unless ($delta_time > $max_time);
+
+ &DEBUG("seenFlushOld: ".&Time2String($delta_time) );
+ delete $seen{$_};
+ $delete++;
+ }
+ } else {
+ &FIXME("seenFlushOld: for PG/NO-DB.");
+ }
+ &VERB("SEEN deleted $delete seen entries.",2);
+
+ &ScheduleThis(1440, "seenFlushOld") if (@_);
+}
+
+sub limitCheck {
+ my $limitplus = $param{'limitcheckPlus'} || 5;
+
+ if (scalar keys %netsplit) {
+ &status("limitcheck: netsplit active.");
+ return;
+ }
+
+ my @channels = split(/[\s\t]+/, lc $param{'limitcheck'});
+
+ foreach (@channels) {
+ next unless (&validChan($_));
+
+ if (!exists $channels{$_}{'o'}{$ident}) {
+ &ERROR("limitcheck: dont have ops on $_.");
+ next;
+ }
+
+ my $newlimit = scalar(keys %{$channels{$_}{''}}) + $limitplus;
+ my $limit = $channels{$_}{'l'};
+
+ next unless (!defined $limit or $limit != $newlimit);
+
+ &rawout("MODE $_ +l $newlimit");
+ }
+
+ my $interval = $param{'limitcheckInterval'} || 10;
+ &ScheduleThis($interval, "limitCheck") if (@_);
+}
+
+sub netsplitCheck {
+ my ($s1,$s2);
+
+ foreach $s1 (keys %netsplitservers) {
+ foreach $s2 (keys %{$netsplitservers{$s1}}) {
+ if (time() - $netsplitservers{$s1}{$s2} > 3600) {
+ &status("netsplit between $s1 and $s2 appears to be stale.");
+ delete $netsplitservers{$s1}{$s2};
+ }
+ }
+ }
+
+ &ScheduleThis(30, "netsplitCheck") if (@_);
+}
+
+sub floodCycle {
+ my $interval = $param{'floodInterval'} || 60; # seconds.
+ my $delete = 0;
+
+ my $who;
+ foreach $who (keys %flood) {
+ foreach (keys %{$flood{$who}}) {
+ if (time() - $flood{$who}{$_} > $interval) {
+ delete $flood{$who}{$_};
+ $delete++;
+ }
+ }
+ }
+ &VERB("floodCycle: deleted $delete items.",2);
+
+ &ScheduleThis($interval, "floodCycle") if (@_); # minutes.
+}
+
+sub seenFlush {
+ my $nick;
+ my $flushed = 0;
+
+ if ($param{'DBType'} =~ /^mysql|pg|postgres/i) {
+ foreach $nick (keys %seencache) {
+ my $exists = &dbGet("seen","nick", $nick, "nick");
+
+ if (defined $exists and $exists) {
+ &dbUpdate("seen", "nick", $nick, (
+ "time" => $seencache{$nick}{'time'},
+ "host" => $seencache{$nick}{'host'},
+ "channel" => $seencache{$nick}{'chan'},
+ "message" => $seencache{$nick}{'msg'},
+ ) );
+ } else {
+ my $retval = &dbInsert("seen", $nick, (
+ "nick" => $seencache{$nick}{'nick'},
+ "time" => $seencache{$nick}{'time'},
+ "host" => $seencache{$nick}{'host'},
+ "channel" => $seencache{$nick}{'chan'},
+ "message" => $seencache{$nick}{'msg'},
+ ) );
+
+ ### TODO: put bad nick into a list and don't do it again!
+ if ($retval == 0) {
+ &ERROR("Should never happen! (nick => $nick) FIXME");
+ }
+ }
+
+ delete $seencache{$nick};
+ $flushed++;
+ }
+
+ } elsif ($param{'DBType'} =~ /^dbm/i) {
+
+ foreach $nick (keys %seencache) {
+ my $retval = &dbInsert("seen", $nick, (
+ "nick" => $seencache{$nick}{'nick'},
+ "time" => $seencache{$nick}{'time'},
+ "host" => $seencache{$nick}{'host'},
+ "channel" => $seencache{$nick}{'chan'},
+ "message" => $seencache{$nick}{'msg'},
+ ) );
+
+ ### TODO: put bad nick into a list and don't do it again!
+ if ($retval == 0) {
+ &ERROR("Should never happen! (nick => $nick) FIXME");
+ }
+
+ delete $seencache{$nick};
+ $flushed++;
+ }
+ } else {
+ &DEBUG("seenFlush: NO VALID FACTOID SUPPORT?");
+ }
+
+ &VERB("Flushed $flushed seen entries.",2);
+
+ my $interval = $param{'seenFlushInterval'} || 60;
+ &ScheduleThis($interval, "seenFlush") if (@_);
+}
+
+sub leakCheck {
+ my ($blah1,$blah2);
+ my $count = 0;
+
+ # flood.
+ foreach $blah1 (keys %flood) {
+ foreach $blah2 (keys %{$flood{$blah1}}) {
+ $count += scalar(keys %{$flood{$blah1}{$blah2}});
+ }
+ }
+ &VERB("\%flood 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}{$_} ...");
+ }
+ }
+ }
+
+ &ScheduleThis(60, "leakCheck") if (@_);
+}
+
+sub ignoreListCheck {
+ my $time = time();
+ my $count = 0;
+
+ foreach (keys %ignoreList) {
+ next if ($ignoreList{$_} == 1);
+ next unless ($time > $ignoreList{$_});
+
+ delete $ignoreList{$_};
+ &status("ignore: $_ has expired.");
+ $count++;
+ }
+ &VERB("ignore: $count items deleted.",2);
+
+ &ScheduleThis(30, "ignoreListCheck") if (@_);
+}
+
+sub ircCheck {
+ my @array = split /[\t\s]+/, $param{'join_channels'};
+ my $iconf = scalar(@array);
+ my $inow = scalar(keys %channels);
+ if ($iconf > 2 and $inow * 2 <= $iconf) {
+ &FIXME("ircCheck: current channels * 2 <= config channels. FIXME.");
+ }
+
+ # 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);
+
+ &status("SHM: nuking shmid $shmid");
+ system("ipcrm shm $shmid >/dev/null");
+ }
+
+ if (!$conn->connected and time - $msgtime > 3600) {
+ &WARN("ircCheck: no msg for 3600 and disco'd! reconnecting!");
+ $msgtime = time(); # just in case.
+ &ircloop();
+ }
+
+ if ($ident !~ /^\Q$param{ircNick}\E$/) {
+ &WARN("ircCheck: ident($ident) != param{ircNick}($param{IrcNick}).");
+ }
+
+ &ScheduleThis(240, "ircCheck") if (@_);
+}
+
+sub shmFlush {
+ my $shmmsg = &shmRead($shm);
+ $shmmsg =~ s/\0//g; # remove padded \0's.
+
+ foreach (split '\|\|', $shmmsg) {
+ &status("shm: Processing '$_'.");
+
+ if (/^DCC SEND (\S+) (\S+)$/) {
+ my ($nick,$file) = ($1,$2);
+ if (exists $dcc{'SEND'}{$who}) {
+ &msg($nick,"DCC already active.");
+ } else {
+ &DEBUG("shm: dcc sending $2 to $1.");
+ $conn->new_send($1,$2);
+ $dcc{'SEND'}{$who} = time();
+ }
+ } elsif (/^DELETE FORK (\S+)$/) {
+ delete $forked{$1};
+ } elsif (/^EVAL (.*)$/) {
+ &DEBUG("evaling '$1'.");
+ eval $1;
+ } else {
+ &DEBUG("shm: unknown msg. ($_)");
+ }
+ }
+
+ &shmWrite($shm,"") if ($shmmsg ne "");
+
+ &ScheduleThis(5, "shmFlush") if (@_);
+}
+
+sub uptimeCycle {
+ &uptimeWriteFile();
+
+ &ScheduleThis(60, "uptimeCycle") if (@_);
+}
+
+sub slashdotCycle {
+ &Forker("slashdot", sub { &Slashdot::slashdotAnnounce(); } );
+
+ &ScheduleThis(60, "slashdotCycle") if (@_);
+}
+
+sub freshmeatCycle {
+ &Forker("freshmeat", sub { &Freshmeat::freshmeatAnnounce(); } );
+
+ &ScheduleThis(60, "freshmeatCycle") if (@_);
+}
+
+sub kernelCycle {
+ &Forker("kernel", sub { &Kernel::kernelAnnounce(); } );
+
+ &ScheduleThis(240, "kernelCycle") if (@_);
+}
+
+sub wingateCheck {
+ return unless &IsParam("wingate");
+ return unless ($param{'wingate'} =~ /^(.*\s+)?$chan(\s+.*)?$/i);
+
+ ### FILE CACHE OF OFFENDING WINGATES.
+ foreach (grep /^$host$/, @wingateBad) {
+ &status("Wingate: RUNNING ON $host BY $who");
+ &ban("*!*\@$host", "") if &IsParam("wingateBan");
+
+ next unless (&IsParam("wingateKick"));
+ &kick($who, "", $param{'wingateKick'})
+ }
+
+ ### 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 = $param{'wingateInterval'} || 60; # 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 {
+ return unless (scalar @wingateCache);
+
+ my $file = "$infobot_base_dir/$param{'ircUser'}.wingate";
+ if ($infobot_pid != $$) {
+ &DEBUG("wingateWriteFile: Reorganising!");
+
+ open(IN, $file);
+ while (<IN>) {
+ 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;
+
+ &ScheduleThis(60, "wingateWriteFile") if (@_);
+}
+
+1;
--- /dev/null
+#
+# Misc.pl: Miscellaneous stuff.
+# Author: xk <xk@leguin.openprojects.net>
+# Version: 20000124
+# NOTE: Based on code by Kevin Lenzo & Patrick Cole (c) 1997
+#
+
+if (&IsParam("useStrict")) { use strict; }
+
+sub help {
+ my $topic = $_[0];
+ my $file = $infobot_misc_dir."/infobot.help";
+ my %help = ();
+
+ if (!open(FILE, $file)) {
+ &ERROR("FAILED loadHelp ($file): $!");
+ return;
+ }
+
+ while (defined(my $help = <FILE>)) {
+ $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) {
+ &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}) {
+ &msg($who,$_);
+ }
+ } else {
+ &msg($who, "no help on $topic. Use 'help' without arguments.");
+ }
+
+ return '';
+}
+
+sub gettimeofday {
+ if ($no_syscall) { # fallback.
+ return time();
+ } else { # the real thing.
+ my $time = pack("LL", 0);
+
+ syscall(&SYS_gettimeofday, $time, 0);
+ my @time = unpack("LL",$time);
+
+ return sprintf("%d.%d", @time);
+ }
+}
+
+###
+### FORM Functions.
+###
+
+###
+# Usage; &formListReply($rand, $prefix, @list);
+sub formListReply {
+ my($rand, $prefix, @list) = @_;
+ my $total = scalar @list;
+ my $maxshow = $param{'maxListReplyCount'} || 10;
+ my $maxlen = $param{'maxListReplyLength'} || 400;
+ my $reply;
+
+ # 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);
+ }
+ @list = @rand;
+ } elsif ($total > $maxshow) {
+ &status("formListReply: truncating list.");
+
+ @list = @list[0..$maxshow-1];
+ }
+
+ # form the reply.
+ while () {
+ $reply = $prefix ."(\002". scalar(@list). "\002 shown";
+ $reply .= "; \002$total\002 total" 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 = shift;
+ my $retval;
+
+ return("0s") if ($time !~ /\d+/ or $time <= 0);
+
+ my $s = int($time) % 60;
+ my $m = int($time / 60) % 60;
+ my $h = int($time / 3600) % 24;
+ my $d = int($time / 86400);
+
+ $retval .= sprintf(" \002%d\002d", $d) if ($d != 0);
+ $retval .= sprintf(" \002%d\002h", $h) if ($h != 0);
+ $retval .= sprintf(" \002%d\002m", $m) if ($m != 0);
+ $retval .= sprintf(" \002%d\002s", $s) if ($s != 0);
+
+ return substr($retval, 1);
+}
+
+###
+### FIX Functions.
+###
+
+# Usage: &fixFileList(@files);
+sub fixFileList {
+ my @files = @_;
+ my %files;
+
+ # generate a hash list.
+ foreach (@files) {
+ if (/^(.*\/)(.*?)$/) {
+ $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 ($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);
+ s/[\cA-\c_]//ig # remove control characters.
+ }
+
+ return $str;
+}
+
+# Usage: &fixPlural($str,$int);
+sub fixPlural {
+ my ($str,$int) = @_;
+
+ 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 (! -f $file) {
+ &WARN("gRLfF: file '$file' does not exist.");
+ return;
+ }
+
+ if (open(IN,$file)) {
+ my @lines = <IN>;
+
+ if (!scalar @lines) {
+ &ERROR("GRLF: nothing loaded?");
+ return;
+ }
+
+ while (my $line = &getRandom(@lines)) {
+ chop $line;
+
+ next if ($line =~ /^\#/);
+ next if ($line =~ /^\s*$/);
+
+ return $line;
+ }
+ } else {
+ &WARN("gRLfF: could not open file '$file'.");
+ return;
+ }
+}
+
+sub getLineFromFile {
+ my($file,$lineno) = @_;
+
+ if (! -f $file) {
+ &ERROR("getLineFromFile: file '$file' does not exist.");
+ return 0;
+ }
+
+ if (open(IN,$file)) {
+ my @lines = <IN>;
+ 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("getLineFromFile: 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];
+
+ srand();
+
+ if ($str =~ /^(\d+)$/) {
+ my $i = $1;
+ my $fuzzy = int(rand 5);
+ if ($i < 10) {
+ return $i*60;
+ }
+ 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 ($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'}$/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) = @_;
+
+ return 1 unless ( -f $file);
+ return 1 if (time() - (stat($file))[8] > $age*60*60*24);
+ my $delta = time() - (stat($file))[8];
+ my $hage = $age*60*60*24;
+ &DEBUG("isStale: not stale! $delta < $hage ($age) ?");
+ return 0;
+}
+
+##########
+### make commands.
+###
+
+# Usage: &makeHostMask($host);
+sub makeHostMask {
+ my ($host) = @_;
+
+ if ($host =~ /^$mask{ip}$/) {
+ return "$1.$2.$3.*";
+ }
+
+ my @array = split(/\./, $host);
+ return $host if (scalar @array <= 3);
+ return "*.".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: &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 !~ /^</) {
+ / \Q$ident$/i and last; # someone said i'm something.
+ /^i('m)? / and last;
+ /^(it|that|there|what)('s)?(\s+|$)/ and last;
+ /^you('re)?(\s+|$)/ and last;
+
+ /^(where|who|why|when|how)(\s+|$)/ and last;
+ /^(this|that|these|those|they)(\s+|$)/ and last;
+ /^(every(one|body)|we) / and last;
+
+ /^say / and last;
+ }
+
+ # uncaught commands.
+ /^add topic / and last; # topic management.
+ /( add$| add |^add )/ and last; # borked teach statement.
+ /^learn / and last; # teach. damn morons.
+ /^tell (\S+) about / and last; # tell.
+ /\=\~/ and last; # substituition.
+ /^\S+ to \S+ \S+/ and last; # babelfish.
+
+ # symbols.
+ /(\"\*)/ and last;
+ /, / and last;
+ /^\'/ and last;
+
+ # delimiters.
+ /\=\>/ 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;
+ /^gives / and last;
+ /^h(is|er) / and last;
+ /^if / and last;
+ / is,/ and last;
+ / it$/ 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 (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;
+}
+
+# Usage: &hasProfanity($string);
+sub hasProfanity {
+ my ($string) = @_;
+ my $profanity = 1;
+
+ for (lc $string) {
+ /fuck/ and last;
+ /dick|dildo/ and last;
+ /shit|turd|crap/ and last;
+ /pussy|[ck]unt/ and last;
+ /wh[0o]re|bitch|slut/ and last;
+
+ $profanity = 0;
+ }
+
+ return $profanity;
+}
+
+sub hasParam {
+ my ($param) = @_;
+
+ if (&IsParam($param)) {
+ return 1;
+ } else {
+ &msg($who, "unfortunately, \002$param\002 is disabled in my configuration") unless ($addrchar);
+ return 0;
+ }
+}
+
+sub Forker {
+ my ($label, $code) = @_;
+ my $pid;
+
+ &shmFlush();
+ &status("double fork detected; not forking.") if ($$ != $infobot_pid);
+
+ if (&IsParam("forking") and $$ == $infobot_pid) {
+ return 'NOREPLY' unless (&addForked($label));
+ $SIG{CHLD} = 'IGNORE';
+ $pid = eval { fork() }; # catch non-forking OSes and other errors
+ return 'NOREPLY' if $pid; # parent does nothing
+ &status("fork starting for '$label', PID == $$.");
+ }
+
+ if (!&loadMyModule($myModules{$label})) {
+ &DEBUG("Forker: failed?");
+ return;
+ }
+
+ if (defined $code) {
+ $code->(); # weird, hey?
+ } else {
+ &WARN("Forker: code not defined!");
+ }
+
+ if (defined $pid) { # child.
+ &delForked($label);
+ &status("fork finished for '$label'.");
+ exit 0;
+ }
+}
+
+sub checkPing {
+ &DEBUG("checkPing() called.");
+ $conn->schedule(60, \&checkPing, "this is a test");
+ $conn->sl("PING $server :".time());
+}
+
+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});
+}
+1;
--- /dev/null
+#
+# Countdown.pl: Count down to a particular date.
+# Author: xk <xk@leguin.openprojects.net>
+# Version: v0.1 (20000104)
+# Created: 20000104
+#
+
+use strict;
+
+#use vars qw();
+
+sub Countdown {
+ my ($query) = @_;
+ my $file = "$infobot_base_dir/$param{'ircUser'}.countdown";
+ my (%date, %desc);
+ my $reply;
+
+ if (!open(IN,$file)) {
+ &ERROR("cannot open $file.");
+ return 0;
+ }
+
+ while (<IN>) {
+ chop;
+ s/[\s\t]+/ /g;
+
+ if (/^(\d{8}) (\S+) (.*)$/) {
+ $date{$2} = $1;
+ $desc{$2} = $3;
+ }
+ }
+ close IN;
+
+ if (defined $query) { # argument.
+ if (!exists $date{$query}) {
+ &msg($who,"error: $query is not in my countdown list.");
+ return 0;
+ }
+
+ $date{$query} =~ /^(\d{4})(\d{2})(\d{2})$/;
+ my($year,$month,$day) = ($1,$2,$3);
+ my $sqldate = "$1-$2-$3";
+
+ ### SQL SPECIFIC.
+ my ($to_days,$dayname,$monname);
+
+ if ($param{'DBType'} =~ /pg|postgres|mysql/i) {
+ $to_days = (&dbRawReturn("SELECT TO_DAYS(NOW()) - TO_DAYS('$sqldate')"))[0];
+ $dayname = (&dbRawReturn("SELECT DAYNAME('$sqldate')"))[0];
+ $monname = (&dbRawReturn("SELECT MONTHNAME('$sqldate')"))[0];
+ } elsif ($param{'DBType'} =~ /^dbm$/i) {
+ &DEBUG("Countdown: FIXME!!!");
+# $to_days =
+# $dayname =
+# $monname =
+ return 1;
+ } else {
+ &ERROR("Countdown: invalid DBType?");
+ return 1;
+ }
+
+ if ($to_days =~ /^\D+$/) {
+ my $str = "to_days is not integer.";
+ &msg($who,$str);
+ &ERROR($str);
+
+ return 1;
+ }
+
+ my @gmtime = gmtime(time());
+ my $daysec = ($gmtime[2]*60*60) + ($gmtime[1]*60) + ($gmtime[0]);
+ my $time = ($to_days*24*60*60);
+
+ if ($to_days >= 0) { # already passed.
+ $time += $daysec;
+ $reply = "T plus ". &Time2String($time) ." ago";
+ } else { # time to go.
+ $time = -$time - $daysec;
+ $reply = "T minus ". &Time2String($time);
+ }
+ $reply .= ", \002(\002$desc{$query}\002)\002 at $dayname, $monname $day $year";
+
+ &performStrictReply($reply .".");
+ return 1;
+ } else { # no argument.
+ my $prefix = "Countdown list ";
+
+ &performStrictReply( &formListReply(0, $prefix, sort keys %date) );
+
+ return 1;
+ }
+}
+
+1;
--- /dev/null
+
+# infobot :: Kevin Lenzo (c) 1997
+
+# once again, thanks to Patrick Cole
+
+#use POSIX;
+use Socket;
+use strict;
+
+use vars qw($waitedpid);
+
+sub REAPER {
+ $SIG{CHLD} = \&REAPER; # loathe sysV
+ $waitedpid = wait;
+}
+
+$SIG{CHLD} = \&REAPER;
+
+sub DNS {
+ my $in = $_[0];
+ my($match, $x, $y, $result);
+ my $pid;
+
+ if (!defined($pid = fork)) {
+ return "no luck, $who";
+ } elsif ($pid) {
+ # parent
+ } else {
+ # child
+ if ($in =~ /(\d+\.\d+\.\d+\.\d+)/) {
+ &status("DNS query by IP address: $in");
+ $match = $1;
+ $y = pack('C4', split(/\./, $match));
+ $x = (gethostbyaddr($y, &AF_INET));
+ if ($x !~ /^\s*$/) {
+ $result = $match." is ".$x unless ($x =~ /^\s*$/);
+ } else {
+ $result = "I can't seem to find that address in DNS";
+ }
+ } else {
+ &status("DNS query by name: $in");
+ $x = join('.',unpack('C4',(gethostbyname($in))[4]));
+ if ($x !~ /^\s*$/) {
+ $result = $in." is ".$x;
+ } else {
+ $result = "I can\'t find that machine name";
+ }
+ }
+
+ if ($msgType eq 'public') {
+ &say($result);
+ } else {
+ &msg($who, $result);
+ }
+ exit; # bye child
+ }
+}
+
+1;
--- /dev/null
+#
+# Debian.pl: Frontend to debian contents and packages files
+# Author: xk <xk@leguin.openprojects.net>
+# Version: v0.7b (20000527)
+# Created: 20000106
+#
+
+package Debian;
+
+use strict;
+
+# format: "alias=real".
+my $defaultdist = "woody";
+my %dists = (
+ "unstable" => "woody",
+ "frozen" => "potato",
+ "stable" => "slink",
+ "incoming" => "incoming",
+);
+
+my %urlcontents = (
+ "debian/Contents-##DIST-i386.gz" =>
+ "ftp://ftp.us.debian.org".
+ "/debian/dists/##DIST/Contents-i386.gz",
+
+ "debian/Contents-##DIST-i386-non-US.gz" =>
+ "ftp://non-us.debian.org".
+ "/debian-non-US/dists/##DIST/non-US/Contents-i386.gz",
+);
+
+my %urlpackages = (
+ "debian/Packages-##DIST-main-i386.gz" =>
+ "ftp://ftp.us.debian.org".
+ "/debian/dists/##DIST/main/binary-i386/Packages.gz",
+ "debian/Packages-##DIST-contrib-i386.gz" =>
+ "ftp://ftp.us.debian.org".
+ "/debian/dists/##DIST/contrib/binary-i386/Packages.gz",
+ "debian/Packages-##DIST-non-free-i386.gz" =>
+ "ftp://ftp.us.debian.org".
+ "/debian/dists/##DIST/non-free/binary-i386/Packages.gz",
+ "debian/Packages-##DIST-non-US-i386.gz" =>
+ "ftp://non-us.debian.org".
+ "/debian-non-US/dists/##DIST/non-US/binary-i386/Packages.gz",
+);
+
+#####################
+### COMMON FUNCTION....
+#######################
+
+####
+# Usage: &DebianDownload(%hash);
+sub DebianDownload {
+ my ($dist, %urls) = @_;
+ my $refresh = $main::param{'debianRefreshInterval'} * 60 * 60 * 24;
+ my $bad = 0;
+ my $good = 0;
+
+ &main::status("Debian: Downloading files for '$dist'.");
+
+ if (! -d "debian/") {
+ &main::status("Debian: creating debian dir.");
+ mkdir("debian/",0755);
+ }
+
+ %urls = &fixNonUS($dist, %urls);
+
+ # 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 {
+ &main::DEBUG("Debian: local '$file' does not exist.");
+ $update++;
+ }
+
+ next unless ($update);
+
+ if ($good + $bad == 0) {
+ &main::msg($main::who, "Updating debian files... please wait.");
+ }
+
+ if (exists $main::debian{$url}) {
+ &main::DEBUG("2: ".(time - $main::debian{$url})." <= $refresh");
+ next if (time() - $main::debian{$url} <= $refresh);
+ &main::DEBUG("stale for url $url; updating!");
+ }
+
+ if ($url =~ /^ftp:\/\/(.*?)\/(\S+)\/(\S+)$/) {
+ my ($host,$path,$thisfile) = ($1,$2,$3);
+
+ # error internally to ftp.
+ # hope it doesn't do anything bad.
+ if (!&main::ftpGet($host,$path,$thisfile,$file)) {
+ &main::DEBUG("deb: down: ftpGet: bad.");
+ $bad++;
+ next;
+ }
+
+ if (! -f $file) {
+ &main::DEBUG("deb: down: ftpGet: !file");
+ $bad++;
+ next;
+ }
+
+ &main::DEBUG("deb: download: good.");
+ $good++;
+ } else {
+ &main::ERROR("Debian: invalid format of url => ($url).");
+ $bad++;
+ next;
+ }
+ }
+
+ if ($good) {
+ &generateIndex($dist);
+ return 1;
+ } else {
+ return -1 unless ($bad); # no download.
+ &main::DEBUG("DD: !good and bad($bad). :(");
+ return 0;
+ }
+}
+
+###########################
+# DEBIAN CONTENTS SEARCH FUNCTIONS.
+########
+
+####
+# Usage: &searchContents($query);
+sub searchContents {
+ my ($dist, $query) = &getDistroFromStr($_[0]);
+ &main::status("Debian: Contents search for '$query' on $dist.");
+ my $dccsend = 0;
+
+ $dccsend++ if ($query =~ s/^dcc\s+//i);
+ ### larne's regex.
+ # $query = $query.'(\.so\.)?([.[[:digit:]]+\.]+)?$';
+
+ $query =~ s/\\([\^\$])/$1/g;
+ $query =~ s/^\s+|\s+$//g;
+ $query =~ s/\*/\\S*/g; # does it even work?
+
+ if (!&main::validExec($query)) {
+ &main::msg($main::who, "search string looks fuzzy.");
+ return;
+ }
+
+ if ($dist eq "incoming") { # nothing yet.
+ &main::DEBUG("sC: dist = 'incoming'. no contents yet.");
+ return;
+ } else {
+ my %urls = &fixDist($dist, %urlcontents);
+ # download contents file.
+ &main::DEBUG("deb: download 1.");
+ if (!&DebianDownload($dist, %urls)) {
+ &main::ERROR("Debian: could not download files.");
+ return;
+ }
+ }
+
+ # start of search.
+ my $start_time = &main::gettimeofday();
+
+ my $found = 0;
+ my %contents;
+ my $search = "$query.*\[ \t]";
+ my $files = join(' ', keys %urlcontents);
+ $files =~ s/##DIST/$dist/g;
+
+ open(IN,"zegrep -h '$search' $files |");
+ while (<IN>) {
+ if (/^\.?\/?(.*?)[\t\s]+(\S+)\n$/) {
+ my ($file,$package) = ("/".$1,$2);
+ if ($query =~ /\//) {
+ next unless ($file =~ /\Q$query\E/);
+ } else {
+ my ($basename) = $file =~ /^.*\/(.*)$/;
+ next unless ($basename =~ /\Q$query\E/);
+ }
+ next if ($query !~ /\.\d\.gz/ and $file =~ /\/man\//);
+
+ $contents{$package}{$file} = 1;
+ $found++;
+ }
+ }
+ close IN;
+
+ my $pkg;
+
+ ### send results with dcc.
+ if ($dccsend) {
+ if (exists $main::dcc{'SEND'}{$main::who}) {
+ &main::msg($main::who, "DCC already active!");
+ return;
+ }
+
+ if (!scalar %contents) {
+ &main::msg($main::who,"search returned no results.");
+ return;
+ }
+
+ if (! -d "Temp/") {
+ mkdir("Temp",0755);
+ }
+
+ my $file = "temp/$main::who.txt";
+ if (!open(OUT,">$file")) {
+ &main::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;
+
+ &main::shmWrite($main::shm, "DCC SEND $main::who $file");
+
+ return;
+ }
+
+ &main::status("Debian: $found results.");
+
+ my @list;
+ foreach $pkg (keys %contents) {
+ my @tmplist = &main::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 = &main::gettimeofday() - $start_time;
+ &main::status(sprintf("Debian: %.02f sec to complete query.", $delta_time)) if ($delta_time > 0);
+
+ my $prefix = "Debian Search of '$query' ";
+ &main::performStrictReply( &main::formListReply(0, $prefix, @list) );
+}
+
+####
+# Usage: &searchAuthor($query);
+sub searchAuthor {
+ my ($dist, $query) = &getDistroFromStr($_[0]);
+ &main::DEBUG("searchAuthor: dist => '$dist', query => '$query'.");
+ $query =~ s/^\s+|\s+$//g;
+
+ # start of search.
+ my $start_time = &main::gettimeofday();
+ &main::status("Debian: starting author search.");
+
+ my $files;
+ my ($bad,$good) = (0,0);
+ my %urls = %urlpackages;
+ ### potato now has the "new" non-US tree like woody does.
+ if ($dist =~ /^(woody|potato)$/) {
+ %urls = &fixNonUS($dist, %urlpackages);
+ }
+
+ foreach (keys %urlpackages) {
+ s/##DIST/$dist/g;
+
+ if (! -f $_) {
+ $bad++;
+ next;
+ }
+
+ $good++;
+ $files .= " ".$_;
+ }
+
+ &main::DEBUG("good = $good, bad = $bad...");
+
+ if ($good == 0 and $bad != 0) {
+ my %urls = &fixDist($dist, %urlpackages);
+ &main::DEBUG("deb: download 2.");
+ if (!&DebianDownload($dist, %urls)) {
+ &main::ERROR("Debian(sA): could not download files.");
+ return;
+ }
+ }
+
+ my (%maint, %pkg, $package);
+ open(IN,"zegrep -h '^Package|^Maintainer' $files |");
+ while (<IN>) {
+ if (/^Package: (\S+)$/) {
+ $package = $1;
+ } elsif (/^Maintainer: (.*) \<(\S+)\>$/) {
+ $maint{$1}{$2} = 1;
+ $pkg{$1}{$package} = 1;
+ } else {
+ &main::WARN("invalid line: '$_'.");
+ }
+ }
+ 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' ";
+ &main::performStrictReply( &main::formListReply(0, $prefix, @list) );
+ return 1;
+ }
+
+ &main::DEBUG("showing all packages by '$list[0]'...");
+
+ my @pkg = sort keys %{$pkg{$list[0]}};
+
+ # show how long it took.
+ my $delta_time = &main::gettimeofday() - $start_time;
+ &main::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 ";
+ &main::performStrictReply( &main::formListReply(0, $prefix, @pkg) );
+}
+
+####
+# Usage: &generateIncoming();
+sub generateIncoming {
+ my $interval = $main::param{'debianRefreshInterval'};
+ my $pkgfile = "debian/Packages-incoming";
+ my $idxfile = $pkgfile.".idx";
+ my $stale = 0;
+ $stale++ if (&main::isStale($pkgfile.".gz", $interval));
+ $stale++ if (&main::isStale($idxfile.".gz", $interval));
+ &main::DEBUG("gI: stale => '$stale'.");
+ return 0 unless ($stale);
+
+ ### STATIC URL.
+ my %ftp = &main::ftpList("llug.sep.bnl.gov", "/pub/debian/Incoming/");
+
+ if (!open(PKG,">$pkgfile")) {
+ &main::ERROR("cannot write to pkg $pkgfile.");
+ return 0;
+ }
+ if (!open(IDX,">$idxfile")) {
+ &main::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.
+
+ &main::status("Debian: generateIncoming() complete.");
+}
+
+
+##############################
+# DEBIAN PACKAGE INFO FUNCTIONS.
+#########
+
+# Usage: &getPackageInfo($query,$file);
+sub getPackageInfo {
+ my ($package, $file) = @_;
+
+ if (! -f $file) {
+ &main::status("gPI: file $file does not exist?");
+ return 'NULL';
+ }
+
+ my $found = 0;
+ my (%pkg, $pkg);
+
+ open(IN, "zcat $file 2>&1 |");
+
+ my $done = 0;
+ while (!eof IN) {
+ $_ = <IN>;
+
+ next if (/^ \S+/); # package long description.
+
+ # package line.
+ if (/^Package: (.*)\n$/) {
+ $pkg = $1;
+ if ($pkg =~ /^$package$/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 (/^i.*size: (.*)$/) {
+ $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;
+ }
+
+### &main::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]));
+ my $interval = $main::param{'debianRefreshInterval'} || 7;
+
+ &main::status("Debian: Searching for package '$package' in '$dist'.");
+
+ # download packages file.
+ # hrm...
+ my %urls = &fixDist($dist, %urlpackages);
+ if ($dist ne "incoming") {
+ &main::DEBUG("deb: download 3.");
+ if (!&DebianDownload($dist, %urls)) { # no good download.
+ &main::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) {
+ &main::status("Debian: no valid package found; checking incoming.");
+ @files = &validPackage($package, "incoming");
+ if (scalar @files) {
+ &main::status("Debian: cool, it exists in incoming.");
+ $incoming++;
+ } else {
+ &main::msg($main::who, "Package '$package' does not exist.");
+ return 0;
+ }
+ }
+
+ if (scalar @files > 1) {
+ &main::WARN("same package in more than one file; random.");
+ &main::DEBUG("THIS SHOULD BE FIXED SOMEHOW!!!");
+ $files[0] = &main::getRandom(@files);
+ }
+
+ if (! -f $files[0]) {
+ &main::WARN("files[0] ($files[0]) doesn't exist.");
+ &main::msg($main::who, "WARNING: $files[0] does not exist? FIXME");
+ 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) {
+ &main::ERROR("D:iP: file '$file' DOES NOT EXIST!!! should never happen.");
+ return 0;
+ }
+ my %pkg = &getPackageInfo($package, $file);
+
+ # 'fm'-like output.
+ if ($query eq "info") {
+ if (scalar keys %pkg > 5) {
+ $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'} .= ", Packaged size: \002". int($pkg{'size'}/1024) ."\002 kB";
+ $pkg{'info'} .= ", Installed size: \002$pkg{'installed'}\002 kB";
+
+ if ($incoming) {
+ &main::status("iP: info requested and pkg is in incoming, too.");
+ my %incpkg = &getPackageInfo($query, "debian/Packages-incoming");
+
+ if (scalar keys %incpkg) {
+ $pkg{'info'} .= ". Is in incoming ($incpkg{'file'}).";
+ } else {
+ &main::ERROR("iP: pkg $query is in incoming but we couldn't get any info?");
+ }
+ }
+ } else {
+ &main::DEBUG("running debianCheck() due to problems (".scalar(keys %pkg).").");
+ &debianCheck();
+ &main::DEBUG("end of debianCheck()");
+
+ &main::msg($main::who,"Debian: Package appears to exist but I could not retrieve info about it...");
+ return;
+ }
+ }
+
+ 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";
+ }
+ }
+
+ &main::performStrictReply("$package: $pkg{$query}");
+}
+
+# Usage: &infoStats($dist);
+sub infoStats {
+ my ($dist) = @_;
+ $dist = &getDistro($dist);
+ return unless (defined $dist);
+
+ &main::DEBUG("infoS: dist => '$dist'.");
+ my $interval = $main::param{'debianRefreshInterval'} || 7;
+
+ # download packages file if needed.
+ my %urls = &fixDist($dist, %urlpackages);
+ &main::DEBUG("deb: download 4.");
+ if (!&DebianDownload($dist, %urls)) {
+ &main::WARN("Debian(iS): could not download ANY files.");
+ &main::msg($main::who, "Debian(iS): internal error.");
+ return;
+ }
+
+ my %stats;
+ my %total;
+ my $file;
+ foreach $file (keys %urlpackages) {
+ $file =~ s/##DIST/$dist/g; # won't work for incoming.
+ &main::DEBUG("file => '$file'.");
+ if (exists $stats{$file}{'count'}) {
+ &main::DEBUG("hrm... duplicate open with $file???");
+ next;
+ }
+
+ open(IN,"zcat $file 2>&1 |");
+
+ if (! -e $file) {
+ &main::DEBUG("iS: $file does not exist.");
+ next;
+ }
+
+ while (!eof IN) {
+ $_ = <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: (.*)$/) { # installed size.
+ $stats{$file}{'isize'} += $1;
+ $total{'isize'} += $1;
+ }
+
+### &main::DEBUG("=> '$_'.");
+ }
+ close IN;
+ }
+
+ &main::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}}) {
+# &main::DEBUG(" '$file' '$_' '$stats{$file}{$_}'.");
+# }
+# }
+
+ return;
+}
+
+
+
+###
+# HELPER FUNCTIONS FOR INFOPACKAGES...
+###
+
+# Usage: &generateIndex();
+sub generateIndex {
+ my (@dists) = @_;
+ &main::DEBUG("Debian: generateIndex() called.");
+ if (!scalar @dists) {
+ &main::ERROR("gI: no dists to generate index.");
+ return 1;
+ }
+
+ foreach (@dists) {
+ my $dist = &getDistro($_); # incase the alias is returned, possible?
+ my $idx = "debian/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 (&main::isStale($idx, $main::param{'debianRefreshInterval'}));
+ if (/^incoming$/i) {
+ &main::DEBUG("gIndex: calling generateIncoming()!");
+ &generateIncoming();
+ next;
+ }
+
+ &main::DEBUG("gIndeX: calling DebianDownload($dist, ...).");
+ &DebianDownload($dist, %urlpackages);
+
+ &main::status("Debian: generating index for '$_'.");
+ if (!open(OUT,">$idx")) {
+ &main::ERROR("cannot write to $idx.");
+ return 0;
+ }
+
+ my $packages;
+ foreach $packages (keys %urlpackages) {
+ $packages =~ s/##DIST/$dist/;
+
+ if (! -e $packages) {
+ &main::ERROR("gIndex: '$packages' does not exist?");
+ next;
+ }
+
+ print OUT "*$packages\n";
+ open(IN,"zcat $packages |");
+
+ while (<IN>) {
+ if (/^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;
+
+ &main::DEBUG("D: validPackage($package, $dist) called.");
+
+ my $error = 0;
+ while (!open(IN, "debian/Packages-$dist.idx")) {
+ if ($error) {
+ &main::ERROR("Packages-$dist.idx does not exist (#1).");
+ return;
+ }
+
+ &generateIndex($dist);
+
+ $error++;
+ }
+
+ my $count = 0;
+ while (<IN>) {
+ if (/^\*(.*)\n$/) {
+ $file = $1;
+ next;
+ }
+
+ if (/^$package\n$/) {
+ push(@files,$file);
+ }
+ $count++;
+ }
+ close IN;
+
+ &main::DEBUG("vP: scanned $count items in index.");
+
+ return @files;
+}
+
+sub searchPackage {
+ my ($dist, $query) = &getDistroFromStr($_[0]);
+ my $file = "debian/Packages-$dist.idx";
+ my @files;
+ my $error = 0;
+
+ &main::status("Debian: Search package matching '$query' in '$dist'.");
+ if ( -z $file) {
+ &main::DEBUG("sP: $file == NULL; removing, redoing.");
+ unlink $file;
+ }
+
+ while (!open(IN, $file)) {
+ &main::ERROR("$file does not exist (#2).");
+ if ($dist eq "incoming") {
+ &main::DEBUG("sP: dist == incoming; calling gI().");
+ &generateIncoming();
+ }
+
+ if ($error) {
+ &main::ERROR("could not generate index!!!");
+ return;
+ }
+ $error++;
+ &generateIndex(($dist));
+ }
+
+ while (<IN>) {
+ chop;
+
+ if (/^\*(.*)$/) {
+ &main::DEBUG("sP: hrm => '$1'.");
+ $file = $1;
+ next;
+ }
+
+ if (/\Q$query\E/) {
+ push(@files,$_);
+ }
+ }
+ close IN;
+
+ return @files;
+}
+
+sub getDistro {
+ my $dist = $_[0];
+
+ if (!defined $dist or $dist eq "") {
+ &main::DEBUG("gD: dist == NULL; dist = defaultdist.");
+ $dist = $defaultdist;
+ }
+
+ if (exists $dists{$dist}) {
+ return $dists{$dist};
+ } else {
+ if (!grep /^\Q$dist\E$/i, %dists) {
+ &main::msg($main::who, "invalid dist '$dist'.");
+ return;
+ }
+
+ return $dist;
+ }
+}
+
+sub getDistroFromStr {
+ my ($str) = @_;
+ my $dists = join '|', %dists;
+ my $dist = $defaultdist;
+
+ if ($str =~ s/\s+($dists)$//i) {
+ &main::status("Debian(gDFS): found dist argument!");
+ $dist = &getDistro(lc $1);
+ $str =~ s/\\+$//;
+ }
+ &main::DEBUG("gDFS: str => '$str', dist => '$dist'.");
+
+ $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{$key} = $val;
+ }
+ return %new;
+}
+
+sub DebianFind {
+ ### H-H-H-HACK HACK HACK :)
+ my ($str) = @_;
+ my ($dist, $query) = &getDistroFromStr($str);
+ my @results = sort &searchPackage($str);
+
+ if (!scalar @results) {
+ &main::Forker("debian", sub { &searchContents($str); } );
+ } elsif (scalar @results == 1) {
+ &main::status("searchPackage returned one result; getting info of package instead!");
+ &main::Forker("debian", sub { &infoPackages("info", "$results[0] $dist"); } );
+ } else {
+ my $prefix = "Debian Package Listing of '$str' ";
+ &main::performStrictReply( &main::formListReply(0, $prefix, @results) );
+ }
+}
+
+### TODO: move DWH to &fixDist() or leave it being called by DD?
+sub fixNonUS {
+ my ($dist, %urls) = @_;
+
+ foreach (keys %urls) {
+ last unless ($dist =~ /^(woody|potato)$/);
+ next unless (/non-US/);
+ &main::DEBUG("DD: Enabling hack(??) for $dist non-US.");
+
+ my $file = $_;
+ my $url = $urls{$_};
+ delete $urls{$file}; # heh.
+
+ foreach ("main","contrib","non-free") {
+ my ($newfile,$newurl) = ($file,$url);
+ # only needed for Packages for now, not Contents; good.
+ $newfile =~ s/non-US/non-US_$_/;
+ $newurl =~ s#non-US/bin#non-US/$_/bin#;
+ $urls{$newfile} = $newurl;
+ }
+
+ &main::DEBUG("DD: Files: ".scalar(keys %urls));
+ last;
+ }
+
+ %urls;
+}
+
+sub debianCheck {
+ my $dir = "debian/";
+ my $error = 0;
+
+ &main::status("debianCheck() called.");
+
+ ### TODO: remove the following loop (check if dir exists before)
+ while (1) {
+ last if (opendir(DEBIAN, $dir));
+ if ($error) {
+ &main::ERROR("dC: cannot opendir debian.");
+ return;
+ }
+ mkdir $dir, 0755;
+ $error++;
+ }
+
+ my $retval = 0;
+ my $file;
+ while (defined($file = readdir DEBIAN)) {
+ next unless ($file =~ /(gz|bz2)$/);
+
+ my $exit = system("gzip -t '$dir/$file'");
+ next unless ($exit);
+ &main::DEBUG("hmr... => ".(time() - (stat($file))[8])."'.");
+ next unless (time() - (stat($file))[8] > 3600);
+
+ &main::DEBUG("dC: exit => '$exit'.");
+ &main::WARN("dC: '$dir/$file' corrupted? deleting!");
+ unlink $dir."/".$file;
+ $retval++;
+ }
+
+ return $retval;
+}
+
+1;
--- /dev/null
+#
+# DebianExtra.pl: Extra stuff for debian
+# Author: xk <xk@leguin.openprojects.net>
+# Version: v0.1 (20000520)
+# Created: 20000520
+#
+
+use strict;
+
+my $bugs_url = "http://master.debian.org/~wakkerma/bugs";
+
+sub debianBugs {
+ my @results = &main::getURL($bugs_url);
+ 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 -- ";
+
+ &main::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 {
+ &main::msg($main::who, "Couldn't retrieve data for debian bug stats.");
+ }
+}
+
+1;
--- /dev/null
+#
+# Dict.pl: Frontend to dict.org.
+# Author: xk <xk@leguin.openprojects.net>
+# Version: v0.6b (19991224).
+# Created: 19990914.
+#
+
+package Dict;
+
+use IO::Socket;
+use strict;
+
+my $server = "dict.org"; # need a specific host||ip.
+my $port = 2628;
+my $proto = getprotobyname('tcp');
+
+###local $SIG{ALRM} = sub { die "alarm\n" };
+
+sub Dict {
+ my ($query) = @_;
+### return unless &main::loadPerlModule("IO::Socket");
+ my $socket = new IO::Socket;
+ my @results;
+
+ # connect.
+ socket($socket, PF_INET, SOCK_STREAM, $proto) or return "error: socket: $!";
+ eval {
+ alarm 15;
+ connect($socket, sockaddr_in($port, inet_aton($server))) or return "error: connect: $!";
+ alarm 0;
+ };
+
+ my $retval;
+ if ($@ && $@ ne "alarm\n") { # failure.
+ $retval = "i could not get info from dict.org";
+ } else { # success.
+ $socket->autoflush(1); # required.
+
+ my $num;
+ if ($query =~ /^(\d+)\s+/) {
+ $num = $1;
+ }
+
+ # body.
+ push(@results, &Dict_Wordnet($socket,$query));
+ push(@results, &Dict_Foldoc($socket,$query));
+ # end.
+
+ print $socket "QUIT\n";
+ close $socket;
+
+ my $total = scalar @results;
+
+ if (defined $num and ($num > $total or $num < 0)) {
+ &msg($main::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]);
+ } else {
+ # suggested by larne and others.
+ my $prefix = "Dictionary '$query' ";
+ $retval = &main::formListReply(1, $prefix, @results);
+ }
+ } elsif ($total == 1) {
+ $retval = "Dictionary '$query' ".$results[0];
+ } else {
+ $retval = "could not find definition for \002$query\002";
+ }
+ }
+
+ &main::performStrictReply($retval);
+}
+
+sub Dict_Wordnet {
+ my ($socket, $query) = @_;
+ my @results;
+
+ &main::status("Dict: asking Wordnet.");
+ print $socket "DEFINE wn \"$query\"\n";
+
+ my $def = "";
+ my $wordtype = "";
+
+ while (<$socket>) {
+ chop; # remove \n
+ chop; # remove \r
+
+ if ($_ eq ".") { # end of def.
+ push(@results, $def);
+ } elsif (/^250 /) { # stats.
+ last;
+ } elsif (/^552 no match/) { # no match.
+ return;
+ } elsif (/^\s+(\S+ )?(\d+)?: (.*)/) { # start of sub def.
+ my $text = $3;
+ $def =~ s/\s+$//;
+### &main::DEBUG("def => '$def'.");
+ push(@results, $def) if ($def ne "");
+ $def = $text;
+
+ if (0) { # old non-fLR format.
+ $def = "$query $wordtype: $text" if (defined $text);
+ $wordtype = substr($1,0,-1) if (defined $1);
+### &main::DEBUG("_ => '$_'.") if (!defined $text);
+ }
+
+ } elsif (/^\s+(.*)/) {
+ s/^\s{2,}/ /;
+ $def .= $_;
+ $def =~ s/\[.*?\]$//g;
+ }
+ }
+
+ &main::status("Dict: wordnet: found ". scalar(@results) ." defs.");
+
+ return if (!scalar @results);
+
+ return @results;
+}
+
+sub Dict_Foldoc {
+ my ($socket,$query) = @_;
+ my @results;
+
+ &main::status("Dict: asking Foldoc.");
+ print $socket "DEFINE foldoc \"$query\"\n";
+
+ my $firsttime = 1;
+ my $string;
+ while (<$socket>) {
+ chop; # remove \n
+ chop; # remove \r
+
+ return if /^552 /; # no match.
+
+ if ($firsttime) {
+ $firsttime-- if ($_ eq "");
+ next;
+ }
+
+ last if (/^250/ or /^\.$/); # stats; end of def.
+
+ s/^\s+|\s+$//g; # each line.
+
+ if ($_ eq "") { # sub def separator.
+ $string =~ s/^\s+|\s+$//g; # sub def.
+ $string =~ s/[{}]//g;
+
+ next if ($string eq "");
+
+ push(@results, $string);
+ $string = "";
+ }
+
+ $string .= $_." ";
+ }
+
+ &main::status("Dict: foldoc: found ". scalar(@results) ." defs.");
+
+ return if (!scalar @results);
+ pop @results; # last def is date of entry.
+
+ return @results;
+}
+
+1;
--- /dev/null
+#
+# DumpVars.pl: Perl variables dumper.
+# Maintained: xk <xk@leguin.openprojects.net>
+# Version: v0.1 (20000114)
+# Created: 20000114
+# NOTE: Ripped from ActivePerl "asp sample" example.
+#
+
+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(" => <NULL>.");
+ }
+ }
+ }
+
+ # 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(" $_ => <NULL>.");
+ }
+ }
+ }
+
+ 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;
--- /dev/null
+#
+# Factoids.pl: Helpers for generating factoids statistics.
+# Author: xk <xk@leguin.openprojects.net>
+# Version: v0.1 (20000514)
+# Splitted: SQLExtras.pl
+#
+
+if (&IsParam("useStrict")) { use strict; }
+
+###
+# Usage: &CmdFactInfo($faqtoid, $query);
+sub CmdFactInfo {
+ my ($faqtoid, $query) = (lc $_[0], $_[1]);
+ my @array;
+ my $string = "";
+
+ if ($faqtoid eq "") {
+ &help("factinfo");
+ return 'NOREPLY';
+ }
+
+ my $i = 0;
+ my %factinfo;
+ my @factinfo = &getFactInfo($faqtoid,"*");
+ foreach ( &dbGetRowInfo("factoids") ) {
+ $factinfo{$_} = $factinfo[$i] || '';
+ $i++;
+ }
+
+ # factoid does not exist.
+ if (scalar @factinfo <= 1) {
+ &performReply("there's no such factoid as \002$faqtoid\002");
+ return 'NOREPLY';
+ }
+
+ # created:
+ if ($factinfo{'created_by'}) {
+
+ $factinfo{'created_by'} =~ s/\!/ </;
+ $factinfo{'created_by'} .= ">";
+ $string = "created by $factinfo{'created_by'}";
+
+ my $time = $factinfo{'created_time'};
+ if ($time) {
+ if (time() - $time > 60*60*24*7) {
+ $string .= " at \037". scalar(localtime $time). "\037";
+ } else {
+ $string .= " ".&Time2String(time() - $time)." ago";
+ }
+ }
+
+ push(@array,$string);
+ }
+
+ # modified:
+# 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(localtime $time). "\037";
+# } else {
+# $string .= " ".&Time2String(time() - $time)." ago";
+# }
+# }
+#
+# my @x;
+# foreach (split ",", $factinfo{'modified_by'}) {
+# /\!/;
+# push(@x, $`);
+# }
+# $string .= "by ".&IJoin(@x);
+#
+# $i++;
+# 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);
+ }
+ }
+
+ $string .= ", " if ($string ne "");
+
+ 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";
+ }
+ }
+
+ 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 'NOREPLY';
+ }
+
+ &performStrictReply("$factinfo{'factoid_key'} -- ". join("; ", @array) .".");
+ return 'NOREPLY';
+}
+
+sub CmdFactStats {
+ my ($type) = @_;
+
+ if ($type =~ /^author$/i) {
+ my %hash = &dbGetCol("factoids", "factoid_key","created_by");
+ my %author;
+
+ foreach (keys %hash) {
+ my $thisnuh = $hash{$_};
+
+ $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 =~ /^broken$/i) {
+ &status("factstats(broken): starting...");
+ my $start_time = &gettimeofday();
+ my %data = &dbGetCol("factoids", "factoid_key","factoid_value");
+ my @list;
+
+ my $delta_time = &gettimeofday() - $start_time;
+ &status(sprintf("factstats(broken): %.02f sec to retreive all factoids.", $delta_time)) if ($delta_time > 0);
+ $start_time = &gettimeofday();
+
+ # parse the factoids.
+ foreach (keys %data) {
+ if (&validFactoid($_, $data{$_}) == 0) {
+ s/([\,\;]+)/\037$1\037/g; # highlight chars.
+ push(@list, $_); # push it.
+ }
+ }
+
+ $delta_time = &gettimeofday() - $start_time;
+ &status(sprintf("factstats(broken): %.02f sec to complete.", $delta_time)) if ($delta_time > 0);
+
+ # bail out on no results.
+ if (scalar @list == 0) {
+ return 'no broken factoids... wooohoo.';
+ }
+
+ # parse the results.
+ my $prefix = "broken factoid ";
+ return &formListReply(1, $prefix, @list);
+
+ } elsif ($type =~ /^deadredir?$/i) {
+ my @list = &searchTable("factoids", "factoid_key",
+ "factoid_value", "^<REPLY> see ");
+ my %redir;
+ my $f;
+
+ for (@list) {
+ my $factoid = $_;
+ my $val = &getFactInfo($factoid, "factoid_value");
+ if ($val =~ /^<REPLY> see( also)? (.*?)\.?$/i) {
+ my $redirf = lc $2;
+ my $redir = &getFactInfo($redirf, "factoid_value");
+ next if (defined $redir);
+
+ $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) {
+ my $start_time = &gettimeofday();
+ &status("factstats(dupe): starting...");
+ my %hash = &dbGetCol("factoids", "factoid_key", "factoid_value", 1);
+ my @list;
+ my $refs = 0;
+ my $v;
+
+ foreach $v (keys %hash) {
+ my $count = scalar(keys %{$hash{$v}});
+ next if ($count == 1);
+
+ my @sublist;
+ foreach (keys %{$hash{$v}}) {
+ if ($v =~ /^<REPLY> 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 = &gettimeofday() - $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 =~ /^lame$/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]);
+ next if ($val =~ /^</);
+ next if ($val =~ /\s{2,}/);
+
+ $key =~ s/\,/\037\,\037/g;
+ push(@list, $key);
+ }
+ $sth->finish;
+
+ # parse the results.
+ my $prefix = "Lame factoids ";
+ return &formListReply(1, $prefix, @list);
+
+ } elsif ($type =~ /^locked$/i) {
+ my %hash = &dbGetCol("factoids", "factoid_key","locked_by");
+ 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 = &dbGetCol("factoids", "factoid_key","created_time");
+ 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 = &gettimeofday();
+
+ # 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", &gettimeofday() - $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 = &dbGetCol("factoids", "factoid_key","factoid_value");
+ 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", "^<REPLY> see ");
+ my %redir;
+ my $f;
+
+ for (@list) {
+ my $factoid = $_;
+ my $val = &getFactInfo($factoid, "factoid_value");
+ if ($val =~ /^<REPLY> see( also)? (.*?)\.?$/i) {
+ my $redir = lc $2;
+ my $redirval = &getFactInfo($redir, "factoid_value");
+ if (defined $redirval) {
+ $redir{$redir}{$factoid} = 1;
+ } else {
+ &WARN("factstats(redir): '$factoid' has loose link => '$redir'.");
+ }
+ }
+ }
+
+ 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 ";
+ return &formListReply(1, $prefix, @newlist);
+
+ } elsif ($type =~ /^request(ed)?$/i) {
+ my %hash = &dbGetCol("factoids", "factoid_key", "requested_count",1);
+
+ if (!scalar keys %hash) {
+ return 'sorry, no factoids have been questioned.';
+ }
+
+ my $count;
+ my @list;
+ foreach $count (sort {$b <=> $a} keys %hash) {
+ my @faqtoids = sort keys %{$hash{$count}};
+
+ for (@faqtoids) {
+ s/([\,\;]+)/\037$1\037/g;
+ }
+
+ push(@list, "$count - ". join(", ", @faqtoids));
+ }
+
+ my $prefix = "factoid statistics on $type ";
+ return &formListReply(0, $prefix, @list);
+
+ } elsif ($type =~ /^requesters?$/i) {
+ my %hash = &dbGetCol("factoids", "factoid_key","requested_by");
+ 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;
+ foreach $count (sort { $b <=> $a } keys %count) {
+ my $requester = join(", ", sort keys %{$count{$count}});
+ push(@list, "$count by $requester");
+ }
+
+ my $prefix = "rank of top factoid requesters: ";
+ return &formListReply(0, $prefix, @list);
+
+ } elsif ($type =~ /^(2|too)long$/i) {
+ my @list;
+
+ # 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]);
+ }
+
+ # factoid_value.
+ my $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]));
+ }
+
+ 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) {
+ my @list = &dbRawReturn("SELECT factoid_key FROM factoids WHERE requested_count IS NULL");
+
+ for (@list) {
+ s/([\,\;]+)/\037$1\037/g;
+ }
+
+ my $prefix = "Unrequested factoids ";
+ return &formListReply(0, $prefix, @list);
+ }
+
+ return "error: invalid type => '$type'.";
+}
+
+sub CmdListAuth {
+ my ($query) = @_;
+ my @list = &searchTable("factoids","factoid_key", "created_by", "^$query!");
+
+ my $prefix = "factoid author list by '$query' ";
+ return &formListReply(1, $prefix, @list);
+}
+
+1;
--- /dev/null
+#
+# Freshmeat.pl: Frontend to www.freshmeat.net
+# Author: xk <xk@leguin.openprojects.net>
+# Version: v0.7c (20000606)
+# Created: 19990930
+#
+
+package Freshmeat;
+
+use strict;
+
+### download compressed version instead?
+
+my %urls = (
+ 'public' => 'http://core.freshmeat.net/backend/appindex.txt',
+ 'private' => 'http://feed.freshmeat.net/appindex/appindex.txt',
+);
+
+####
+# Usage: &Freshmeat($string);
+sub Freshmeat {
+ my $sstr = lc($_[0]);
+ my $refresh = $main::param{'freshmeatRefreshInterval'} * 60 * 60;
+
+ my $last_refresh = &main::dbGet("freshmeat", "name","_","stable");
+ my $renewtable = 0;
+
+ if (defined $last_refresh) {
+ $renewtable++ if (time() - $last_refresh > $refresh);
+ } else {
+ $renewtable++;
+ }
+ $renewtable++ if (&main::countKeys("freshmeat") < 10);
+
+ if ($renewtable and $$ == $main::infobot_pid) {
+ &main::Forker("freshmeat", sub {
+ &downloadIndex();
+ &Freshmeat($sstr);
+ } );
+ return if ($$ == $main::infobot_pid);
+ }
+
+ if (!&showPackage($sstr)) { # no exact match.
+ my $start_time = &main::gettimeofday();
+ my %hash;
+
+ # search by key first.
+ foreach (&main::searchTable("freshmeat", "name","name",$sstr)) {
+ $hash{$_} = 1 unless exists $hash{$_};
+ }
+
+ foreach (&main::searchTable("freshmeat", "name","oneliner", $sstr)) {
+ $hash{$_} = 1 unless exists $hash{$_};
+ last if (scalar keys %hash > 15);
+ }
+
+ my @list = keys %hash;
+ # search by value, if we have enough room to do it.
+ if (scalar @list == 1) {
+ &main::DEBUG("only one partial match found; showing full info.");
+ &showPackage($list[0]);
+ return;
+ }
+
+ # show how long it took.
+ my $delta_time = &main::gettimeofday() - $start_time;
+ &main::status(sprintf("freshmeat: %.02f sec to complete query.", $delta_time)) if ($delta_time > 0);
+
+ for (@list) {
+ tr/A-Z/a-z/;
+ s/([\,\;]+)/\037$1\037/g;
+ }
+
+ &main::performStrictReply( &main::formListReply(1, "Freshmeat ", @list) );
+ }
+}
+
+sub showPackage {
+ my ($pkg) = @_;
+ my @fm = &main::dbGet("freshmeat", "name",$pkg,"*");
+
+ if (scalar @fm) { #1: perfect match of name.
+ my $retval;
+ $retval = "$fm[0] \002(\002$fm[11]\002)\002, ";
+ $retval .= "section $fm[3], ";
+ $retval .= "is $fm[4]. ";
+ $retval .= "Stable: \002$fm[1]\002, ";
+ $retval .= "Development: \002$fm[2]\002. ";
+ $retval .= $fm[5] || $fm[6]; # fallback to 'download'.
+ $retval .= " deb: ".$fm[8] if ($fm[8] ne ""); # 'deb'.
+ &main::performStrictReply($retval);
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+sub downloadIndex {
+ my $start_time = &main::gettimeofday(); # set the start time.
+ my $idx = "$main::infobot_base_dir/Temp/fm_index.txt";
+
+ &main::msg($main::who, "Updating freshmeat index... please wait");
+
+ if (&main::isStale($idx, 1)) {
+ &main::status("Freshmeat: fetching data.");
+ foreach (keys %urls) {
+ &main::DEBUG("FM: urls{$_} => '$urls{$_}'.");
+ my $retval = &main::getURLAsFile($urls{$_}, $idx);
+ next if ($retval eq "403");
+ &main::DEBUG("FM: last! retval => '$retval'.");
+ last;
+ }
+ } else {
+ &main::status("Freshmeat: local file hack.");
+ }
+
+ if (! -e $idx) {
+ &main::msg($main::who, "the freshmeat butcher is closed.");
+ return;
+ }
+
+ if ( -s $idx < 100000) {
+ &main::DEBUG("FM: index too small?");
+ unlink $idx;
+ &main::msg($main::who, "internal error?");
+ return;
+ }
+
+ ### TODO: do not dump full contents to an array.
+ ### => process on the fly instead but how?
+ open(IN, $idx);
+
+ # delete the table before we redo it.
+ &main::deleteTable("freshmeat");
+
+ ### lets get on with business.
+ # set the last refresh time. fixes multiple spawn bug.
+ &main::dbSet("freshmeat", "name","_","stable",time());
+
+ my $i = 0;
+ while (my $line = <IN>) {
+ chop $line;
+ $i++ if ($line eq "%%");
+ last if ($i == 2);
+ }
+
+ &main::dbRaw("LOCK", "LOCK TABLES freshmeat WRITE");
+ my @data;
+ while (my $line = <IN>) {
+ chop $line;
+ if ($line ne "%%") {
+ push(@data,$line);
+ next;
+ }
+
+ if ($i % 100 == 0 and $i != 0) {
+ &main::DEBUG("FM: unlocking and locking.");
+ &main::dbRaw("UNLOCK", "UNLOCK TABLES");
+ sleep 1; # another lame hack to "prevent" errors.
+ &main::dbRaw("LOCK", "LOCK TABLES freshmeat WRITE");
+ }
+
+ $i++;
+ pop @data;
+ $data[1] ||= "none";
+ $data[2] ||= "none";
+ &main::dbSetRow("freshmeat", @data);
+ @data = ();
+ }
+ close IN;
+ &main::DEBUG("FM: data ".scalar(@data) );
+ &main::dbRaw("UNLOCK", "UNLOCK TABLES");
+
+ my $delta_time = &main::gettimeofday() - $start_time;
+ &main::status(sprintf("Freshmeat: %.02f sec to complete.", $delta_time)) if ($delta_time > 0);
+
+ my $count = &main::countKeys("freshmeat");
+ &main::status("Freshmeat: $count entries loaded.");
+}
+
+sub freshmeatAnnounce {
+ my $file = "$main::infobot_base_dir/Temp/fm_recent.txt";
+ my @old;
+
+ if ( -f $file) {
+ open(IN, $file);
+ while (<IN>) {
+ chop;
+ push(@old,$_);
+ }
+ close IN;
+ }
+
+ my @array = &main::getURL("http://core.freshmeat.net/backend/recentnews.txt");
+ my @now;
+
+ while (@array) {
+ my($what,$date,$url) = splice(@array,0,3);
+ push(@now, $what);
+ }
+
+ ### ...
+
+ if (! -f $file) {
+ open(OUT, ">$file");
+ foreach (@now) {
+ print OUT "$_\n";
+ }
+ close OUT;
+
+ return;
+ }
+
+ my @new;
+ for(my $i=0; $i<scalar(@old); $i++) {
+ last if ($now[$i] eq $old[0]);
+ push(@new, $now[$i]);
+ }
+
+ if (!scalar @new) {
+ &main::DEBUG("fA: no new items.");
+ return;
+ }
+
+ my $chan;
+ my @chans = split(/[\s\t]+/, lc $main::param{'freshmeatAnnounce'});
+ @chans = keys(%main::channels) unless (scalar @chans);
+
+ my $line = "Freshmeat update: ".join(" \002::\002 ", @new);
+ foreach (@chans) {
+ next unless (&main::validChan($_));
+
+ &main::status("sending freshmeat update to $_.");
+ &main::notice($_, $line);
+ }
+
+ open(OUT, ">$file");
+ foreach (@now) {
+ print OUT "$_\n";
+ }
+ close OUT;
+}
+
+1;
--- /dev/null
+#
+# Kernel.pl: Frontend to linux.kernel.org.
+# Author: xk <xk@leguin.openprojects.net>
+# Version: v0.3 (19990919).
+# Created: 19990729
+#
+
+package Kernel;
+
+use IO::Socket;
+use strict;
+
+### TODO: change this to http instead of finger?
+my $server = "ftp.kernel.org";
+my $port = 79;
+my $proto = getprotobyname('tcp');
+
+###local $SIG{ALRM} = sub { die "alarm\n" };
+
+sub kernelGetInfo {
+### return unless &main::loadPerlModule("IO::Socket");
+
+ my $socket = new IO::Socket;
+
+ socket($socket, PF_INET, SOCK_STREAM, $proto) or return "error: socket: $!";
+ eval {
+ alarm 15;
+ connect($socket, sockaddr_in($port, inet_aton($server))) or return "error: connect: $!";
+ alarm 0;
+ };
+
+ my @retval;
+
+ if ($@ && $@ ne "alarm\n") { # failed.
+ return;
+ }
+
+ $socket->autoflush(1); # required.
+
+ print $socket "\n";
+ while (<$socket>) {
+ chop;
+
+ s/\t//g;
+ s/\s$//;
+ s/\s+/ /g;
+
+ next if ($_ eq "");
+
+ push(@retval, $_);
+ }
+ close $socket;
+
+ @retval;
+}
+
+sub Kernel {
+ my @now = &kernelGetInfo();
+ if (!scalar @now) {
+ &main::msg($main::who, "failed.");
+ return;
+ }
+
+ foreach (@now) {
+ &main::msg($main::who, $_);
+ }
+}
+
+sub kernelAnnounce {
+ my $file = "$main::infobot_base_dir/Temp/kernel.txt";
+ my @now = &kernelGetInfo();
+ my @old;
+
+ if (!scalar @now) {
+ &main::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 (<IN>) {
+ chop;
+ push(@old,$_);
+ }
+ close IN;
+ }
+
+ my @new;
+ for(my $i=0; $i<scalar(@old); $i++) {
+ next if ($old[$i] eq $now[$i]);
+ push(@new, $now[$i]);
+ }
+
+ if (scalar @now != scalar @old) {
+ &main::DEBUG("kA: scalar mismatch; removing and exiting.");
+ unlink $file;
+ return;
+ }
+
+ if (!scalar @new) {
+ &main::DEBUG("kA: no new kernels.");
+ return;
+ }
+
+ my $chan;
+ my @chans = split(/[\s\t]+/, lc $main::param{'kernelAnnounce'});
+ @chans = keys(%main::channels) unless (scalar @chans);
+ foreach $chan (@chans) {
+ next unless (&main::validChan($chan));
+
+ &main::status("sending kernel update to $chan.");
+ foreach (@new) {
+ &main::notice($chan, "Kernel: $_");
+ }
+ }
+
+ open(OUT, ">$file");
+ foreach (@now) {
+ print OUT "$_\n";
+ }
+ close OUT;
+}
+
+1;
--- /dev/null
+#
+# infobot copyright (C) kevin lenzo 1997-98
+#
+
+if (&IsParam("useStrict")) { use strict; }
+
+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.1415/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 = 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) {
+ &DEBUG("math: locMsg => '$locMsg'... FIXME");
+ } else {
+ $locMsg = "undefined";
+ }
+ }
+ } else {
+ $locMsg = "";
+ }
+
+ if ($locMsg ne $message) {
+ return $locMsg;
+ } else {
+ return '';
+ }
+}
+
+1;
--- /dev/null
+#
+# Quote.pl: retrieve stock quotes from yahoo
+# heavily based on Slashdot.pl
+# Version: v0.1
+# Author: Michael Urman <mu@zen.dhis.org>
+# Licensing: Artistic
+#
+
+package Quote;
+
+use strict;
+
+sub Quote {
+ my $stock = shift;
+ my @results = &main::getURL("http://quote.yahoo.com/q?s=$stock&d=v1");
+
+ if (!scalar @results) {
+ &main::msg($main::who, "i could not get a stock quote :(");
+ }
+
+ my $flathtml = join(" ", @results);
+
+ local ($/) = "\n\n";
+ for ($flathtml) {
+ s/.*?\<tr align=right\>//;
+ s/Chart.*//;
+ s/<.*?>//g; # remove HTML stuff.
+ s/\s{2,}/ /g; # reduce excessive spaces.
+ s/^\s+//; # get rid of leading whitespace
+ s/\s+$//; # get rid of trailing whitespace
+ }
+ my $reply = $flathtml;
+
+ if ($reply eq "" or length($reply) > 160) {
+ $reply = "i couldn't get the quote for $stock. sorry. :(";
+ }
+
+ &main::performStrictReply($reply);
+}
+
+1;
--- /dev/null
+#
+# RootWarn.pl: Warn people about usage of root on IRC.
+# Author: xk <xk@leguin.openprojects.net>
+# Version: v0.2c (19991125)
+# Created: 19991008
+#
+
+use strict;
+
+sub rootWarn {
+ my ($nick,$user,$host,$chan) = @_;
+ my $attempt = &dbGet("rootwarn", "nick", lc($nick), "attempt") || 0;
+
+ if ($attempt == 0) { # first timer.
+ if (&IsParam("rootWarnMode") && $param{'rootWarnMode'} =~ /aggressive/i) {
+ &status(">>> Detected root user; notifying nick and channel.");
+ rawout("PRIVMSG $chan :R".("O" x int(rand 80 + 2))."T has landed!");
+ } else {
+ &status(">>> Detected root user; notifying user");
+ }
+
+ if ($_ = &getFactoid("root")) {
+ &msg($nick, "root is $_");
+ } else {
+ &status("root needs to be defined in database.");
+ }
+
+ } elsif ($attempt < 2) { # 2nd/3rd time occurrance.
+ &status("RootWarn: not first time root user; msg'ing $nick.");
+ if ($_ = &getFactoid("root again")) {
+ &msg($nick, $_);
+ } else {
+ &status("root again needs to be defined in database.");
+ }
+
+ } else { # >3rd time occurrance.
+ if (&IsParam("rootWarnMode")) {
+ if ($param{'rootWarnMode'} =~ /aggressive/i) {
+ if ($channels{$chan}{'o'}{$ident}) {
+ &status("RootWarn: $nick... sigh... bye bye.");
+ rawout("MODE $chan +b *!root\@$host"); # ban
+ &kick($chan,$nick,"bye bye");
+ }
+ }
+ }
+ }
+
+ $attempt++;
+ ### TODO: OPTIMIZE THIS.
+ &dbSet("rootwarn", "nick", lc($nick), "attempt", $attempt);
+ &dbSet("rootwarn", "nick", lc($nick), "time", time());
+ &dbSet("rootwarn", "nick", lc($nick), "host", $user."\@".$host);
+ &dbSet("rootwarn", "nick", lc($nick), "channel", $chan);
+
+ return;
+}
+
+# Extras function.
+sub CmdrootWarn {
+ my $reply;
+ my $count = &countKeys("rootwarn");
+
+ if ($count == 0) {
+ return "no-one has been warned about root, woohoo";
+ }
+
+ # reply #1.
+ $reply = "there ".&fixPlural("has",$count) ." been \002$i\002 ".
+ &fixPlural("rooter",$count) ." warned about root.";
+
+ # reply #2.
+ $found = 0;
+ my $query = "SELECT attempt FROM rootwarn WHERE attempt > 2";
+ my $sth = $dbh->prepare($query);
+ $sth->execute;
+
+ while (my @row = $sth->fetchrow_array) {
+ $found++;
+ }
+
+ $sth->finish;
+
+ if ($found) {
+ $reply .= " Of which, \002$found\002 ".
+ &fixPlural("rooter",$found)." ".
+ &fixPlural("has",$found).
+ " done it at least 3 times.";
+ }
+
+ return $reply;
+}
+
+1;
--- /dev/null
+#
+# infobot copyright kevin lenzo 1997-1998
+# rewritten by xk 1999
+#
+
+package Search;
+
+use strict;
+
+###
+# Search(keys||vals, str);
+sub Search {
+ my ($type, $str) = @_;
+ my $start_time = &main::gettimeofday();
+ my @list;
+
+ $type =~ s/s$//; # nice work-around.
+
+ if ($type eq "value") { # search by value.
+ @list = &main::searchTable("factoids", "factoid_key", "factoid_value", $str);
+ } else { # search by key.
+ @list = &main::searchTable("factoids", "factoid_key", "factoid_key", $str);
+ }
+
+ my $delta_time = sprintf("%.02f", &main::gettimeofday() - $start_time);
+ &main::status("search: took $delta_time sec for query.") if ($delta_time > 0);
+
+ my $prefix = "Factoid search of '\002$str\002' by $type ";
+
+ &main::performStrictReply( &main::formListReply(1, $prefix, @list) );
+}
+
+1;
--- /dev/null
+#
+# Slashdot.pl: Slashdot headline retrival
+# Author: Chris Tessone <tessone@imsa.edu>
+# Modified: xk <xk@leguin.openprojects.net>
+# Licensing: Artistic License (as perl itself)
+# Version: v0.4 (19991125)
+#
+
+###
+# fixed up to use XML'd /. backdoor 7/31 by richardh@rahga.com
+# My only request if this gets included in infobot is that the
+# other header gets trimmed to 2 lines, dump the fluff ;) -rah
+#
+# added a status message so people know to install LWP - oznoid
+# also simplified the return code because it wasn't working.
+###
+
+package Slashdot;
+
+use strict;
+
+sub slashdotParse {
+ my @list;
+
+ foreach (@_) {
+ next unless (/<title>(.*?)<\/title>/);
+ my $title = $1;
+ $title =~ s/&\;/&/g;
+ push(@list, $title);
+ }
+
+ return @list;
+}
+
+sub Slashdot {
+ my @results = &main::getURL("http://www.slashdot.org/slashdot.xml");
+ my $retval = "i could not get the headlines.";
+
+ if (scalar @results) {
+ my $prefix = "Slashdot Headlines ";
+ my @list = &slashdotParse(@results);
+ $retval = &main::formListReply(0, $prefix, @list);
+ }
+
+ &main::performStrictReply($retval);
+}
+
+sub slashdotAnnounce {
+ my $file = "Temp/slashdot.xml";
+ if (! -d "Temp/") {
+ &main::DEBUG("sdA: mking dir.");
+ mkdir "Temp", 0755;
+ }
+
+ my @Cxml = &main::getURL("http://www.slashdot.org/slashdot.xml");
+ if (!scalar @Cxml) {
+ &main::DEBUG("sdA: failure (Cxml == NULL).");
+ return;
+ }
+
+ if (! -e $file) { # first time run.
+ open(OUT, ">$file");
+ foreach (@Cxml) {
+ print OUT "$_\n";
+ }
+ close OUT;
+
+ return;
+ }
+
+ my @Oxml;
+ open(IN, $file);
+ while (<IN>) {
+ chop;
+ push(@Oxml,$_);
+ }
+ close IN;
+
+ my @Chl = &slashdotParse(@Cxml);
+ my @Ohl = &slashdotParse(@Oxml);
+
+ my @new;
+ foreach (@Chl) {
+ last if ($_ eq $Ohl[0]);
+ push(@new, $_);
+ }
+
+ if (scalar @new == 0) {
+ &main::status("Slashdot: no new headlines.");
+ return;
+ }
+
+ if (scalar @new == scalar @Chl) {
+ &main::DEBUG("sdA: scalar(new) == scalar(Chl). bad?");
+ }
+
+ open(OUT,">$file");
+ foreach (@Cxml) {
+ print OUT "$_\n";
+ }
+ close OUT;
+
+ my $line = "Slashdot: News for nerds, stuff that matters -- ".
+ join(" \002::\002 ", @new);
+
+ my @chans = split(/[\s\t]+/, lc $main::param{'slashdotAnnounce'});
+ @chans = keys(%main::channels) unless (scalar @chans);
+ foreach (@chans) {
+ next unless (&main::validChan($_));
+
+ &main::status("sending slashdot update to $_.");
+ &main::notice($_, $line);
+ }
+ sleep 1; # just in case?
+}
+
+1;
--- /dev/null
+#
+# Topic.pl: Advanced topic management (maxtopiclen>=512)
+# Author: xk <xk@leguin.openprojects.net>
+# Version: v0.8 (19990919).
+# Created: 19990720
+#
+
+use strict;
+use vars qw(%topiccmp);
+no strict "refs"; ### FIXME!!!
+
+###############################
+##### INTERNAL FUNCTIONS
+###############################
+
+###
+# Usage: &topicDecipher(chan);
+sub topicDecipher {
+ my $chan = shift;
+ my @results;
+
+ if (!exists $topic{$chan}{'Current'}) {
+ &DEBUG("Topic: does not exist for $chan.");
+ return;
+ }
+
+ &DEBUG("Topic: hrm => '$topic{$chan}{'Current'}'.");
+
+ foreach (split /\|\|/, $topic{$chan}{'Current'}) {
+ s/^\s+//;
+ s/\s+$//;
+
+ # very nice fix to solve the null subtopic problem.
+ ### if nick contains a space, treat topic as ownerless.
+ if (/^\(.*?\)$/) {
+ next unless ($1 =~ /\s/);
+ }
+
+ my $subtopic = $_;
+ my $owner = "Unknown";
+ if (/(.*)\s+\((.*?)\)$/) {
+ $subtopic = $1;
+ $owner = $2;
+ }
+
+ push(@results, "$subtopic||$owner");
+ }
+
+ return @results;
+}
+
+###
+# Usage: &topicCipher(@topics);
+sub topicCipher {
+ if (!@_) {
+ &DEBUG("topicCipher: topic is NULL.");
+ return;
+ }
+
+ my $result;
+ foreach (@_) {
+ my ($subtopic, $setby) = split /\|\|/;
+
+ $result .= " || $subtopic";
+ next if ($setby eq "" or $setby =~ /unknown/i);
+
+ $result .= " (" . $setby . ")";
+ }
+
+ return substr($result, 4);
+}
+
+###
+# Usage: &topicNew($chan, $topic, $updateMsg, $topicUpdate);
+sub topicNew {
+ my ($chan, $topic, $updateMsg, $topicUpdate) = @_;
+ my $maxlen = 470;
+
+ if ($channels{$chan}{t} and !$channels{$chan}{o}{$ident}) {
+ &msg($who, "error: cannot change topic without ops. (channel is +t) :(");
+ return 0;
+ }
+
+ if (defined $topiccmp{$chan} and $topiccmp{$chan} eq $topic) {
+ &msg($who, "warning: action had no effect on topic; no change required.");
+ return 0;
+ }
+
+ # bail out if the new topic is too long.
+ my $newlen = length($chan.$topic);
+ if ($newlen > $maxlen) {
+ &msg($who, "new topic will be too long. ($newlen > $maxlen)");
+ return 0;
+ }
+
+ $topic{$chan}{'Current'} = $topic;
+
+ # notification that the topic was altered.
+ if (!$topicUpdate) { # for cached changes with '-'.
+ &performReply("okay");
+ return 1;
+ }
+
+ if ($updateMsg ne "") {
+ &msg($who, $updateMsg);
+ }
+
+ $topic{$chan}{'Last'} = $topic;
+ $topic{$chan}{'Who'} = $orig{who}."!".$uh;
+ $topic{$chan}{'Time'} = time();
+ rawout("TOPIC $chan :$topic");
+ &topicAddHistory($chan,$topic);
+ return 1;
+}
+
+###
+# Usage: &topicAddHistory($chan,$topic);
+sub topicAddHistory {
+ my ($chan, $topic) = @_;
+ my $dupe = 0;
+
+ return 1 if ($topic eq ""); # required fix.
+
+ foreach (@{ $topic{$chan}{'History'} }) {
+ next if ($_ ne "" and $_ ne $topic);
+ # checking length is required.
+
+ $dupe++;
+ last;
+ }
+
+ return 1 if $dupe;
+
+ my @topics = @{ $topic{$chan}{'History'} };
+ unshift(@topics, $topic);
+ pop(@topics) while (scalar @topics > 6);
+ $topic{$chan}{'History'} = \@topics;
+
+ return $dupe;
+}
+
+###############################
+##### HELPER FUNCTIONS
+###############################
+
+### TODO.
+# sub topicNew {
+# sub topicDelete {
+# sub topicList {
+# sub topicModify {
+# sub topicMove {
+# sub topicShuffle {
+# sub topicHistory {
+# sub topicRestore {
+# sub topicRehash {
+# sub topicHelp {
+
+###############################
+##### MAIN
+###############################
+
+###
+# Usage: &Topic($cmd, $args);
+sub Topic {
+ my ($chan, $cmd, $args) = @_;
+ my $topicUpdate = 1;
+
+ if ($cmd =~ /^-(\S+)/) {
+ $topicUpdate = 0;
+ $cmd = $1;
+ }
+
+ if ($cmd =~ /^(add)$/i) {
+ ### CMD: ADD:
+ if ($args eq "") {
+ &help("topic add");
+ return 'NOREPLY';
+ }
+
+ # heh, joeyh. 19990819. -xk
+ if ($who =~ /\|\|/) {
+ &msg($who, "error: you have an invalid nick, loser!");
+ return 'NOREPLY';
+ }
+
+ my @prev = &topicDecipher($chan);
+ my $new = "$args ($orig{who})";
+ if (scalar @prev) {
+ $new = &topicCipher(@prev, sprintf("%s||%s", $args, $who));
+ }
+ &topicNew($chan, $new, "", $topicUpdate);
+
+ } elsif ($cmd =~ /^(del|delete|rm|remove|kill|purge)$/i) {
+ ### CMD: DEL:
+ my @subtopics = &topicDecipher($chan);
+ my $topiccount = scalar @subtopics;
+
+ if ($topiccount == 0) {
+ &msg($who, "No topic set.");
+ return 'NOREPLY';
+ }
+
+ if ($args eq "") {
+ &help("topic del");
+ return 'NOREPLY';
+ }
+
+ $args = ",".$args.",";
+ $args =~ s/\s+//g;
+ $args =~ s/(first|1st)/1/i;
+ $args =~ s/last/$topiccount/i;
+ $args =~ s/,-(\d+)/,1-$1/;
+ $args =~ s/(\d+)-,/,$1-$topiccount/;
+
+ if ($args !~ /[\,\-\d]/) {
+ &msg($who, "error: Invalid argument ($args).");
+ return 'NOREPLY';
+ }
+
+ foreach (split ",", $args) {
+ next if ($_ eq "");
+ my @delete;
+
+ # change to hash list instead of array?
+ if (/^(\d+)-(\d+)$/) {
+ my ($from,$to) = ($1,$2);
+ ($from,$to) = ($2,$1) if ($from > $to);
+
+ push(@delete, $1..$2);
+ } elsif (/^(\d+)$/) {
+ push(@delete, $1);
+ } else {
+ &msg($who, "error: Invalid sub-argument ($_).");
+ return 'NOREPLY';
+ }
+
+ foreach (@delete) {
+ if ($_ > $topiccount || $_ < 1) {
+ &msg($who, "error: argument out of range. (max: $topiccount)");
+ return 'NOREPLY';
+ }
+ # skip if already deleted.
+ # only checked if x-y range is given.
+ next unless (defined($subtopics[$_-1]));
+
+ my ($subtopic,$whoby) = split('\|\|', $subtopics[$_-1]);
+ $whoby = "unknown" if ($whoby eq "");
+ &msg($who, "Deleting topic: $subtopic ($whoby)");
+ undef $subtopics[$_-1];
+ }
+ }
+
+ my @newtopics;
+ foreach (@subtopics) {
+ next unless (defined $_);
+ push(@newtopics, $_);
+ }
+
+ &topicNew($chan, &topicCipher(@newtopics), "", $topicUpdate);
+
+ } elsif ($cmd =~ /^list$/i) {
+ ### CMD: LIST:
+ my @topics = &topicDecipher($chan);
+ if (!scalar @topics) {
+ &msg($who, "No topics for \002$chan\002.");
+ return 'NOREPLY';
+ }
+
+ &msg($who, "Topics for \002$chan\002:");
+ &msg($who, "No \002[\002 Set by \002]\002 Topic");
+
+ my $i = 1;
+ foreach (@topics) {
+ my ($subtopic, $setby) = split /\|\|/;
+
+ &msg($who, sprintf(" %d. \002[\002%-10s\002]\002 %s",
+ $i, $setby, $subtopic));
+ $i++;
+ }
+ &msg($who, "End of Topics.");
+
+ } elsif ($cmd =~ /^(mod|modify|change|alter)$/i) {
+ ### CMD: MOD:
+
+ if ($args eq "") {
+ &help("topic mod");
+ return 'NOREPLY';
+ }
+
+ # a warning message instead of halting. we kind of trust the user now.
+ if ($args =~ /\|\|/) {
+ &msg($who, "warning: adding double pipes manually == evil. be warned.");
+ }
+
+ # SAR patch. mu++
+ if ($args =~ m|^\s*s([/,#])(.+?)\1(.*?)\1([a-z]*);?\s*$|) {
+ my ($delim, $op, $np, $flags) = ($1,quotemeta $2,$3,$4);
+
+ if ($flags !~ /^(g)?$/) {
+ &msg($who, "error: Invalid flags to regex.");
+ return 'NOREPLY';
+ }
+
+ my $topic = $topic{$chan}{'Current'};
+
+ if (($flags eq "g" and $topic =~ s/$op/$np/g) ||
+ ($flags eq "" and $topic =~ s/$op/$np/)) {
+
+ $_ = "Modifying topic with sar s/$op/$np/.";
+ &topicNew($chan, $topic, $_, $topicUpdate);
+ } else {
+ &msg($who, "warning: regex not found in topic.");
+ }
+ return 'NOREPLY';
+ }
+
+ &msg($who, "error: Invalid regex. Try s/1/2/, s#3#4#...");
+
+ } elsif ($cmd =~ /^(mv|move)$/i) {
+ ### CMD: MV:
+
+ if ($args eq "") {
+ &help("topic mv");
+ return 'NOREPLY';
+ }
+
+ if ($args =~ /^(first|last|\d+)\s+(before|after|swap)\s+(first|last|\d+)$/i) {
+ my ($from, $action, $to) = ($1,$2,$3);
+ my @subtopics = &topicDecipher($chan);
+ my @newtopics;
+ my $topiccount = scalar @subtopics;
+
+ if ($topiccount == 1) {
+ &msg($who, "error: impossible to move the only subtopic, dumbass.");
+ return 'NOREPLY';
+ }
+
+ # Is there an easier way to do this?
+ $from =~ s/first/1/i;
+ $to =~ s/first/1/i;
+ $from =~ s/last/$topiccount/i;
+ $to =~ s/last/$topiccount/i;
+
+ if ($from > $topiccount || $to > $topiccount || $from < 1 || $to < 1) {
+ &msg($who, "error: <from> or <to> is out of range.");
+ return 'NOREPLY';
+ }
+
+ if ($from == $to) {
+ &msg($who, "error: <from> and <to> are the same.");
+ return 'NOREPLY';
+ }
+
+ if ($action =~ /^(swap)$/i) {
+ my $tmp = $subtopics[$to - 1];
+ $subtopics[$to - 1] = $subtopics[$from - 1];
+ $subtopics[$from - 1] = $tmp;
+
+ $_ = "Swapped #\002$from\002 with #\002$to\002.";
+ &topicNew($chan, &topicCipher(@subtopics), $_, $topicUpdate);
+ return 'NOREPLY';
+ }
+
+ # action != swap:
+ # Is there a better way to do this? guess not.
+ my $i = 1;
+ my $subtopic = $subtopics[$from - 1];
+ foreach (@subtopics) {
+ my $j = $i*2 - 1;
+ $newtopics[$j] = $_ if ($i != $from);
+ $i++;
+ }
+
+ if ($action =~ /^(before|b4)$/i) {
+ $newtopics[$to*2-2] = $subtopic;
+ } else {
+ # action =~ /after/.
+ $newtopics[$to*2] = $subtopic;
+ }
+
+ undef @subtopics; # lets reuse this array.
+ foreach (@newtopics) {
+ next if ($_ eq "");
+ push(@subtopics, $_);
+ }
+
+ $_ = "Moved #\002$from\002 $action #\002$to\002.";
+ &topicNew($chan, &topicCipher(@subtopics), $_, $topicUpdate);
+
+ return 'NOREPLY';
+ }
+
+ &msg($who, "Invalid arguments.");
+
+ } elsif ($cmd =~ /^shuffle$/i) {
+ ### CMD: SHUFFLE:
+ my @subtopics = &topicDecipher($chan);
+ my @newtopics;
+
+ foreach (&makeRandom(scalar @subtopics)) {
+ push(@newtopics, $subtopics[$_]);
+ }
+
+ $_ = "Shuffling the bag of lollies.";
+ &topicNew($chan, &topicCipher(@newtopics), $_, $topicUpdate);
+
+ } elsif ($cmd =~ /^(history)$/i) {
+ ### CMD: HISTORY:
+ if (!scalar @{$topic{$chan}{'History'}}) {
+ &msg($who, "Sorry, no topics in history list.");
+ return 'NOREPLY';
+ }
+
+ &msg($who, "History of topics on \002$chan\002:");
+ for (1 .. scalar @{$topic{$chan}{'History'}}) {
+ my $topic = ${$topic{$chan}{'History'}}[$_-1];
+ &msg($who, " #\002$_\002: $topic");
+
+ # To prevent excess floods.
+ sleep 1 if (length($topic) > 160);
+ }
+ &msg($who, "End of list.");
+
+ } elsif ($cmd =~ /^restore$/i) {
+ ### CMD: RESTORE:
+ if ($args eq "") {
+ &help("topic restore");
+ return 'NOREPLY';
+ }
+
+ # following needs to be verified.
+ if ($args =~ /^last$/i) {
+ if (${$topic{$chan}{'History'}}[0] eq $topic{$chan}{'Current'}) {
+ &msg($who,"error: cannot restore last topic because it's mine.");
+ return 'NOREPLY';
+ }
+ $args = 1;
+ }
+
+ if ($args =~ /\d+/) {
+ if ($args > $#{$topic{$chan}{'History'}} || $args < 1) {
+ &msg($who, "error: argument is out of range.");
+ return 'NOREPLY';
+ }
+
+ $_ = "Changing topic according to request.";
+ &topicNew($chan, ${$topic{$chan}{'History'}}[$args-1], $_, $topicUpdate);
+
+ return 'NOREPLY';
+ }
+
+ &msg($who, "error: argument is not positive integer.");
+
+ } elsif ($cmd =~ /^rehash$/i) {
+ ### CMD: REHASH.
+ $_ = "Rehashing topic...";
+ &topicNew($chan, $topic{$chan}{'Current'}, $_, 1);
+
+ } elsif ($cmd =~ /^info$/i) {
+ ### CMD: INFO.
+ my $reply = "no topic info.";
+ if (exists $topic{$chan}{'Who'} and exists $topic{$chan}{'Time'}) {
+ $reply = "topic on \002$chan\002 was last set by ".
+ $topic{$chan}{'Who'}. ". This was done ".
+ &Time2String(time() - $topic{$chan}{'Time'}) ." ago.";
+ }
+
+ &performStrictReply($reply);
+ } else {
+ ### CMD: HELP:
+ if ($cmd ne "" and $cmd !~ /^help/i) {
+ &msg($who, "Invalid command [$cmd].");
+ &msg($who, "Try 'help topic'.");
+ return 'NOREPLY';
+ }
+
+ &help("topic");
+ }
+
+ return 'NOREPLY';
+}
+
+1;
--- /dev/null
+# Units.pl: convert units of measurement
+# Author: M-J. Dominus (mjd-perl-units-id-iut+buobvys+@plover.com)
+# License: GPL, Copyright (C) 1996,1999
+# NOTE: Integrated into blootbot by xk.
+
+package Units;
+
+#$DEBUG_p = 1;
+#$DEBUG_o = 1;
+#$DEBUG_l = 1;
+my %unittab; # Definitions loaded here
+
+# Metric prefixes. These must be powers of ten or change the
+# token_value subroutine
+BEGIN {
+ %PREF = (yocto => -24,
+ zepto => -21,
+ atto => -18,
+ femto => -15,
+ pico => -12,
+ nano => -9,
+ micro => -6,
+# u => -6,
+ milli => -3,
+ centi => -2,
+ deci => -1,
+ deca => 1,
+ deka => 1,
+ hecto => 2,
+ hect => 2,
+ kilo => 3,
+ myria => 4,
+ mega => 6,
+ giga => 9,
+ tera => 12,
+ peta => 15,
+ exa => 18,
+ yotta => 21,
+ zetta => 24,
+ );
+ $PREF = join '|', sort {$PREF{$a} <=> $PREF{$b}} (keys %PREF);
+}
+
+
+################################################################
+#
+# Main program here
+#
+################################################################
+
+{ my $defs_read = 0;
+ $defs_read += read_defs("$main::infobot_misc_dir/unittab");
+
+ unless ($defs_read) {
+ &main::ERROR("Could not read any of the initialization files UNITTAB");
+ return;
+ }
+}
+
+sub convertUnits {
+ my ($from,$to) = @_;
+
+ # POWER HACK.
+ $from =~ s/\^(\-?\d+)/$1/;
+ $to =~ s/\^(\-?\d+)/$1/;
+ my %powers = (
+ 2 => 'squared?',
+ 3 => 'cubed?',
+ );
+ foreach (keys %powers) {
+ $from =~ s/(\D+) $powers{$_}$/$1\Q$_/;
+ $to =~ s/(\D+) $powers{$_}$/$1\Q$_/;
+ }
+ # END OF POWER HACK.
+
+ ### FROM:
+ trim($from);
+ if ($from =~ s/^\s*\#\s*//) {
+ if (definition_line($from)) {
+ &main::DEBUG("Defined.");
+ } else {
+ &main::DEBUG("Error: $PARSE_ERROR.");
+ }
+ &main::DEBUG("FAILURE 1.");
+ return;
+ }
+ unless ($from =~ /\S/) {
+ &main::DEBUG("FAILURE 2");
+ return;
+ }
+
+ my $hu = parse_unit($from);
+ if (is_Zero($hu)) {
+ &main::DEBUG($PARSE_ERROR);
+ &main::msg($main::who, $PARSE_ERROR);
+ return;
+ }
+
+ ### TO:
+ my $wu;
+ trim($to);
+ redo unless $to =~ /\S/;
+ $wu = parse_unit($to);
+ if (is_Zero($wu)) {
+ &main::DEBUG($PARSE_ERROR);
+ }
+
+ my $quot = unit_divide($hu, $wu);
+ if (is_dimensionless($quot)) {
+ my $q = $quot->{_};
+ if ($q == 0) {
+ &main::performStrictReply("$to is an invalid unit?");
+ return;
+ }
+ # yet another powers hack.
+ $from =~ s/(\D+)(\d)/$1\^$2/g;
+ $to =~ s/(\D+)(\d)/$1\^$2/g;
+
+ &main::performStrictReply(sprintf("$from is approximately \002%.6g\002 $to", $q));
+ } else {
+ &main::performStrictReply("$from cannot be correctly converted to $to.");
+
+# print
+# "conformability (Not the same dimension)\n",
+# "\t", $from, " is ", text_unit($hu), "\n",
+# "\t", $to, " is ", text_unit($wu), "\n",
+# ;
+ }
+}
+
+
+################################################################
+
+sub read_defs {
+ my ($file) = @_;
+ unless (open D, $file) {
+ if ($show_file_loading) {
+ print STDERR "Couldn't open file `$file': $!; skipping.\n";
+ }
+ return 0;
+ }
+ while (<D>) {
+ s/\#.*$//;
+ trim($_);
+ next unless /\S/;
+
+ print ">>> $_\n" if $DEBUG_d;
+ my $r = definition_line($_);
+ unless (defined $r) {
+ warn "Error in line $. of $file: $PARSE_ERROR. Skipping.\n";
+ }
+ }
+ print STDERR "Loaded file `$file'.\n" if $show_file_loading;
+ return 1;
+}
+
+sub definition_line {
+ my ($line) = @_;
+ my ($name, $data) = split /\s+/, $line, 2;
+ my $value = parse_unit($data);
+ if (is_Zero($value)) {
+ return;
+ }
+ if (is_fundamental($value)) {
+ return $unittab{$name} = {_ => 1, $name => 1};
+ } else {
+ return $unittab{$name} = $value;
+ }
+}
+
+sub trim {
+ $_[0] =~ s/\s+$//;
+ $_[0] =~ s/^\s+//;
+}
+
+sub Zero () { +{ _ => 0 } }
+
+sub is_Zero {
+ $_[0]{_} == 0;
+}
+
+sub unit_lookup {
+ my ($name) = @_;
+ print STDERR "Looking up unit `$name'\n" if $DEBUG_l;
+ return $unittab{$name} if exists $unittab{$name};
+ if ($name =~ /s$/) {
+ my $shortname = $name;
+ $shortname =~ s/s$//;
+ return $unittab{$shortname} if exists $unittab{$shortname};
+ }
+ my ($prefix, $rest) = ($name =~ /^($PREF-?)(.*)/o);
+ unless ($prefix) {
+ $PARSE_ERROR = "Unknown unit `$name'";
+ return Zero;
+ }
+ my $base_unit = unit_lookup($rest); # Recursive
+ con_multiply($base_unit, 10**$PREF{$prefix});
+}
+
+sub unit_multiply {
+ my ($a, $b) = @_;
+ print STDERR "Multiplying @{[%$a]} by @{[%$b]}: \n" if $DEBUG_o;
+ my $r = {%$a};
+ $r->{_} *= $b->{_};
+ my $u;
+ for $u (keys %$b) {
+ next if $u eq '_';
+ $r->{$u} += $b->{$u};
+ }
+ print STDERR "\tResult: @{[%$r]}\n" if $DEBUG_o;
+ $r;
+}
+
+sub unit_divide {
+ my ($a, $b) = @_;
+ if ($b->{_} == 0) {
+ &main::DEBUG("Division by zero error");
+ return;
+ }
+ my $r = {%$a};
+ $r->{_} /= $b->{_};
+ my $u;
+ for $u (keys %$b) {
+ next if $u eq '_';
+ $r->{$u} -= $b->{$u};
+ }
+ $r;
+}
+
+sub unit_power {
+ my ($p, $u) = @_;
+ print STDERR "Raising unit @{[%$u]} to power $p.\n" if $DEBUG_o;
+ my $r = {%$u};
+ $r->{_} **= $p;
+ my $d;
+ for $d (keys %$r) {
+ next if $d eq '_';
+ $r->{$d} *= $p;
+ }
+ print STDERR "\tResult: @{[%$r]}\n" if $DEBUG_o;
+ $r;
+}
+
+sub unit_dimensionless {
+ print "Turning $_[0] into a dimensionless unit.\n" if $DEBUG_o;
+ return +{_ => $_[0]};
+}
+
+sub con_multiply {
+ my ($u, $c) = @_;
+ print STDERR "Multiplying unit @{[%$u]} by constant $c.\n" if $DEBUG_o;
+ my $r = {%$u};
+ $r->{_} *= $c;
+ print STDERR "\tResult: @{[%$r]}\n" if $DEBUG_o;
+ $r;
+}
+
+sub is_dimensionless {
+ my ($r) = @_;
+ my $u;
+ for $u (keys %$r) {
+ next if $u eq '_';
+ return if $r->{$u} != 0;
+ }
+ return 1;
+}
+
+# Generate bogus unit value that signals that a new fundamental unit
+# is being defined
+sub new_fundamental_unit {
+ return +{__ => 'new', _ => 1};
+}
+
+# Recognize this bogus value when it appears again.
+sub is_fundamental {
+ exists $_[0]{__};
+}
+
+sub text_unit {
+ my ($u) = @_;
+ my (@pos, @neg);
+ my $k;
+ my $c = $u->{_};
+ for $k (sort keys %$u) {
+ next if $k eq '_';
+ push @pos, $k if $u->{$k} > 0;
+ push @neg, $k if $u->{$k} < 0;
+ }
+ my $text = ($c == 1 ? '' : $c);
+ my $d;
+ for $d (@pos) {
+ my $e = $u->{$d};
+ $text .= " $d";
+ $text .= "^$e" if $e > 1;
+ }
+
+ $text .= ' per' if @neg;
+ for $d (@neg) {
+ my $e = - $u->{$d};
+ $text .= " $d";
+ $text .= "^$e" if $e > 1;
+ }
+
+ $text;
+}
+################################################################
+#
+# I'm the parser
+#
+
+BEGIN {
+ sub sh { ['shift', $_[0]] };
+ sub go { ['goto', $_[0]] };
+ @actions =
+ (
+ # Initial state
+ {PREFIX => sh(1),
+ NUMBER => sh(2),
+ NAME => sh(3),
+ FUNDAMENTAL => sh(4),
+ FRACTION => sh(5),
+ '(' => sh(6),
+ 'unit' => go(7),
+ 'topunit' => go(17),
+ 'constant' => go(8),
+ },
+ # State 1: constant -> PREFIX .
+ { _ => ['reduce', 1, 'constant']},
+ # State 2: constant -> NUMBER .
+ { _ => ['reduce', 1, 'constant']},
+ # State 3: unit -> NAME .
+ { _ => ['reduce', 1, 'unit', \&unit_lookup ]},
+ # State 4: unit -> FUNDAMENTAL .
+ { _ => ['reduce', 1, 'unit', \&new_fundamental_unit ]},
+ # State 5: constant -> FRACTION .
+ { _ => ['reduce', 1, 'constant']},
+ # State 6: unit -> '(' . unit ')'
+ {PREFIX => sh(1),
+ NUMBER => sh(2),
+ NAME => sh(3),
+ FUNDAMENTAL => sh(4),
+ FRACTION => sh(5),
+ '(' => sh(6),
+ 'unit' => go(9),
+ 'constant' => go(8),
+ },
+ # State 7: topunit -> unit .
+ # unit -> unit . TIMES unit
+ # unit -> unit . DIVIDE unit
+ # unit -> unit . NUMBER
+ {NUMBER => sh(10),
+ TIMES => sh(11),
+ DIVIDE => sh(12),
+ _ => ['reduce', 1, 'topunit'],
+ },
+ # State 8: unit -> constant . unit
+ # unit -> constant .
+ {PREFIX => sh(1),
+ NUMBER => sh(2), # Shift-reduce conflict resolved in favor of shift
+ NAME => sh(3),
+ FUNDAMENTAL => sh(4),
+ FRACTION => sh(5),
+ '(' => sh(6),
+ _ => ['reduce', 1, 'unit', \&unit_dimensionless],
+ 'unit' => go(13),
+ 'constant' => go(8),
+ },
+ # State 9: unit -> unit . TIMES unit
+ # unit -> unit . DIVIDE unit
+ # unit -> '(' unit . ')'
+ # unit -> unit . NUMBER
+ {NUMBER => sh(10),
+ TIMES => sh(11),
+ DIVIDE => sh(12),
+ ')' => sh(14),
+ },
+ # State 10: unit -> unit NUMBER .
+ { _ => ['reduce', 2, 'unit',
+ sub {
+ unless (int($_[1]) == $_[1]) {
+ ABORT("Nonintegral power $_[1]");
+ return Zero;
+ }
+ unit_power(@_);
+ }
+ ],
+ },
+ # State 11: unit -> unit TIMES . unit
+ {PREFIX => sh(1),
+ NUMBER => sh(2),
+ NAME => sh(3),
+ FUNDAMENTAL => sh(4),
+ FRACTION => sh(5),
+ '(' => sh(6),
+ 'unit' => go(15),
+ 'constant' => go(8),
+ },
+ # State 12: unit -> unit DIVIDE . unit
+ {PREFIX => sh(1),
+ NUMBER => sh(2),
+ NAME => sh(3),
+ FUNDAMENTAL => sh(4),
+ FRACTION => sh(5),
+ '(' => sh(6),
+ 'unit' => go(16),
+ 'constant' => go(8),
+ },
+ # State 13: unit -> unit . TIMES unit
+ # unit -> unit . DIVIDE unit
+ # unit -> constant unit .
+ # unit -> unit . NUMBER
+ {NUMBER => sh(10), # Shift-reduce conflict resolved in favor of shift
+ TIMES => sh(11), # Shift-reduce conflict resolved in favor of shift
+ DIVIDE => sh(12), # Shift-reduce conflict resolved in favor of shift
+ _ => ['reduce', 2, 'unit', \&con_multiply],
+ },
+ # State 14: unit => '(' unit ')' .
+ { _ => ['reduce', 3, 'unit', sub {$_[1]}] },
+ # State 15: unit -> unit . TIMES unit
+ # unit -> unit TIMES unit .
+ # unit -> unit . DIVIDE unit
+ # unit -> unit . NUMBER
+ {NUMBER => sh(10), # Shift-reduce conflict resolved in favor of shift
+ _ => ['reduce', 3, 'unit', sub {unit_multiply($_[0], $_[2])}],
+ },
+ # State 16: unit -> unit . TIMES unit
+ # unit -> unit DIVIDE unit .
+ # unit -> unit . DIVIDE unit
+ # unit -> unit . NUMBER
+ {NUMBER => sh(10), # Shift-reduce conflict resolved in favor of shift
+ _ => ['reduce', 3, 'unit', sub{unit_divide($_[2], $_[0])}],
+ },
+ # State 17: Finishing path
+ {EOF => go(18),},
+ # State 18: Final state
+ {_ => ['accept']},
+ );
+}
+
+sub ABORT {
+ $PARSE_ERROR = shift;
+}
+
+sub parse_unit {
+ my ($s) = @_;
+ my $tokens = lex($s);
+ my $STATE = 0;
+ my (@state_st, @val_st);
+
+ $PARSE_ERROR = undef;
+
+ # Now let's run the parser
+ for (;;) {
+ return Zero if $PARSE_ERROR;
+ my $la = @$tokens ? token_type($tokens->[0]) : 'EOF';
+ print STDERR "Now in state $STATE. Lookahead type is $la.\n" if $DEBUG_p;
+ print STDERR "State stack is (@state_st).\n" if $DEBUG_p;
+ my $actiontab = $actions[$STATE];
+ my $action = $actiontab->{$la} || $actiontab->{_};
+ unless ($action) {
+ $PARSE_ERROR = 'Syntax error';
+ return Zero;
+ }
+
+ my ($primary, @actargs) = @$action;
+ print STDERR " $primary (@actargs)\n" if $DEBUG_p;
+ if ($primary eq 'accept') {
+ return $val_st[0]; # Success!
+ } elsif ($primary eq 'shift') {
+ my $token = shift @$tokens;
+ my $val = token_value($token);
+ push @val_st, $val;
+ push @state_st, $STATE;
+ $STATE = $actargs[0];
+ } elsif ($primary eq 'goto') {
+ $STATE = $actargs[0];
+ } elsif ($primary eq 'reduce') {
+ my ($n_args, $result_type, $semantic) = @actargs;
+ my @arglist;
+# push @state_st, 'FAKE'; # So that we only really remove n-1 states
+ while ($n_args--) {
+ push @arglist, pop @val_st;
+ $STATE = pop @state_st;
+ }
+ my $result = $semantic ? &$semantic(@arglist) : $arglist[0];
+ push @val_st, $result;
+ push @state_st, $STATE;
+# $STATE = $state_st[-1];
+ print STDERR "Post-reduction state is $STATE.\n" if $DEBUG_p;
+
+ # Now look for `goto' actions
+ my $goto = $actions[$STATE]{$result_type};
+ unless ($goto && $goto->[0] eq 'goto') {
+ &main::ERROR("No post-reduction goto in state $STATE for $result_type.");
+ return;
+ }
+ print STDERR "goto $goto->[1]\n" if $DEBUG_p;
+ $STATE = $goto->[1];
+ } else {
+ &main::ERROR("Bad primary $primary");
+ return;
+ }
+ }
+}
+
+
+sub lex {
+ my ($s) = @_;
+ my @t = split /(
+ \*{3} # Special `new unit' symbol
+ | [()*-] # Symbol
+ | \s*(?:\/|\bper\b)\s* # Division
+ | \d*\.\d+(?:[eE]-?\d+)? # Decimal number
+ | \d+\|\d+ # Fraction
+ | \d+ # Integer
+# | (?:$PREF)-? # Prefix (handle differently)
+ | [A-Za-z_][A-Za-z_.]* # identifier
+ | \s+ # White space
+ )/ox, $s;
+ @t = grep {$_ ne ''} @t; # Discard empty and all-white tokens
+ \@t;
+}
+
+sub token_type {
+ my ($token) = @_;
+ return $token->[0] if ref $token;
+ return $token if $token =~ /[()]/;
+ return TIMES if $token =~ /^\s+$/;
+ return FUNDAMENTAL if $token eq '***';
+ return DIVIDE if $token =~ /^\s*(\/|\bper\b)\s*$/;
+ return TIMES if $token eq '*' || $token eq '-';
+ return FRACTION if $token =~ /^\d+\|\d+$/;
+ return NUMBER if $token =~ /^[.\d]/;
+# return PREFIX if $token =~ /^$PREF/o;
+ return NAME;
+}
+
+sub token_value {
+ my ($token) = @_;
+ return $token if $token =~ /^([()*\/-]|\s*\bper\b\s*)$/;
+ if ($token =~ /(\d+)\|(\d+)/) {
+ if ($2 == 0) {
+ ABORT("Zero denominator in fraction `$token'");
+ return 0;
+ }
+ return $1/$2;
+# } elsif ($token =~ /$PREF/o) {
+# $token =~ s/-$//;
+# return 10**($PREF{$token});
+ }
+ return $token; # Perl takes care of the others.
+}
+
+1;
--- /dev/null
+#
+# Uptime.pl: Uptime daemon for infobot.
+# Author: xk <xk@lenguin.openprojects.net>
+# Version: v0.3 (19991008)
+# Created: 19990925.
+#
+
+use strict;
+
+my $uptimerecords = 3;
+
+sub uptimeNow {
+ return time() - $^T;
+}
+
+sub uptimeStr {
+ my $uptimenow = &uptimeNow();
+
+ if (defined $_[0]) {
+ return "$uptimenow.$$ running $infobot_version, ended ". localtime(time());
+ } else {
+ return "$uptimenow running $infobot_version";
+ }
+}
+
+sub uptimeGetInfo {
+ my (%uptime,%done,%pid);
+ my ($uptime,$pid);
+ my @results;
+ my $file = $file{utm};
+
+ if (!open(IN, $file)) {
+ &status("Writing uptime file for first time usage (nothing special).");
+ open(OUT,">$file");
+ close OUT;
+ } else {
+ while (<IN>) {
+ chop;
+
+ if (/^(\d+)\.(\d+) (.*)/) {
+ $uptime{$1}{$2} = $3;
+ }
+ }
+ close IN;
+ }
+
+ &uptimeStr(1) =~ /^(\d+)\.(\d+) (.*)/;
+ $uptime{$1}{$2} = $3;
+
+ # fixed up bad implementation :)
+ # should be no problems, even if uptime or pid is duplicated.
+ foreach $uptime (sort {$b <=> $a} keys %uptime) {
+ foreach $pid (keys %{$uptime{$uptime}}) {
+ next if (exists $done{$pid});
+
+ push(@results,"$uptime.$pid $uptime{$uptime}{$pid}");
+ $done{$pid} = 1;
+ last if (scalar @results == $uptimerecords);
+ }
+ last if (scalar @results == $uptimerecords);
+ }
+
+ return @results;
+}
+
+sub uptimeWriteFile {
+ my @results = &uptimeGetInfo();
+ my $file = $file{utm};
+
+ if (!open(OUT,">$file")) {
+ &status("error: cannot write to $file.");
+ return;
+ }
+
+ foreach (@results) {
+ print OUT "$_\n";
+ }
+
+ close OUT;
+
+ $conn->schedule(&getRandomInt("1800-3600"), \&uptimeWriteFile, "");
+ return;
+}
+
+1;
--- /dev/null
+#
+# UserDCC.pl: User Commands, DCC CHAT.
+# Author: xk <xk@leguin.openprojects.net>
+# Version: v0.1 (20000707)
+# Created: 20000707 (from UserExtra.pl)
+#
+
+if (&IsParam("useStrict")) { use strict; }
+
+sub userDCC {
+ # hrm...
+ $message =~ s/\s+$//;
+
+ ### for all users.
+ # quit.
+ if ($message =~ /^(exit|quit)$/i) {
+ # do ircII clients support remote close? if so, cool!
+ &status("userDCC: quit called. FIXME");
+### $irc->removeconn($dcc{'CHAT'}{lc $who});
+
+ return 'NOREPLY';
+ }
+
+ # who.
+ if ($message =~ /^who$/i) {
+ my $count = scalar(keys %{$dcc{'CHAT'}});
+ &performStrictReply("Start of who ($count users).");
+ foreach (keys %{$dcc{'CHAT'}}) {
+ &performStrictReply("=> $_");
+ }
+ &performStrictReply("End of who.");
+
+ return 'NOREPLY';
+ }
+
+ ### for those users with enough flags.
+
+ # 4op.
+ if ($message =~ /^4op(\s+($mask{chan}))?$/i) {
+ return 'NOREPLY' unless (&hasFlag("o"));
+
+ my $chan = $2;
+
+ if ($chan eq "") {
+ &help("4op");
+ return 'NOREPLY';
+ }
+
+ if (!$channels{$chan}{'o'}{$ident}) {
+ &msg($who, "i don't have ops on $chan to do that.");
+ return 'NOREPLY';
+ }
+
+ # on non-4mode(<4) servers, this may be exploited.
+ if ($channels{$chan}{'o'}{$who}) {
+ rawout("MODE $chan -o+o-o+o". (" $who" x 4));
+ } else {
+ rawout("MODE $chan +o-o+o-o". (" $who" x 4));
+ }
+
+ return 'NOREPLY';
+ }
+
+ # backlog.
+ if ($message =~ /^backlog(\s+(.*))?$/i) {
+ return 'NOREPLY' unless (&hasFlag("o"));
+ return 'NOREPLY' unless (&hasParam("backlog"));
+ my $num = $2;
+ my $max = $param{'backlog'};
+
+ if (!defined $num) {
+ &help("backlog");
+ return 'NOREPLY';
+ } elsif ($num !~ /^\d+/) {
+ &msg($who, "error: argument is not positive integer.");
+ return 'NOREPLY';
+ } elsif ($num > $max or $num < 0) {
+ &msg($who, "error: argument is out of range (max $max).");
+ return 'NOREPLY';
+ }
+
+ &msg($who, "Start of backlog...");
+ for (0..$num-1) {
+ sleep 1 if ($_ % 4 == 0 and $_ != 0);
+ $conn->privmsg($who, "[".($_+1)."]: $backlog[$max-$num+$_]");
+ }
+ &msg($who, "End of backlog.");
+
+ return 'NOREPLY';
+ }
+
+ # dump variables.
+ if ($message =~ /^dumpvars$/i) {
+ return 'NOREPLY' unless (&hasFlag("o"));
+ return '' unless (&IsParam("dumpvars"));
+
+ &status("Dumping all variables...");
+ &dumpallvars();
+
+ return 'NOREPLY';
+ }
+
+ # kick.
+ if ($message =~ /^kick(\s+(\S+)(\s+(\S+))?)?/) {
+ return 'NOREPLY' unless (&hasFlag("o"));
+ my ($nick,$chan) = (lc $2,lc $4);
+
+ if ($nick eq "") {
+ &help("kick");
+ return 'NOREPLY';
+ }
+
+ if (&validChan($chan) == 0) {
+ &msg($who,"error: invalid channel \002$chan\002");
+ return 'NOREPLY';
+ }
+
+ if (&IsNickInChan($nick,$chan) == 0) {
+ &msg($who,"$nick is not in $chan.");
+ return 'NOREPLY';
+ }
+
+ &kick($nick,$chan);
+
+ return 'NOREPLY';
+ }
+
+ # ignore.
+ if ($message =~ /^ignore(\s+(\S+))?$/i) {
+ return 'NOREPLY' unless (&hasFlag("o"));
+ my $what = lc $2;
+
+ if ($what eq "") {
+ &help("ignore");
+ return 'NOREPLY';
+ }
+
+ my $expire = $param{'ignoreTempExpire'} || 60;
+ $ignoreList{$what} = time() + ($expire * 60);
+ &status("ignoring $what at $who's request");
+ &msg($who, "added $what to the ignore list");
+
+ return 'NOREPLY';
+ }
+
+ # unignore.
+ if ($message =~ /^unignore(\s+(\S+))?$/i) {
+ return 'NOREPLY' unless (&hasFlag("o"));
+ my $what = $2;
+
+ if ($what eq "") {
+ &help("unignore");
+ return 'NOREPLY';
+ }
+
+ if ($ignoreList{$what}) {
+ &status("unignoring $what at $userHandle's request");
+ delete $ignoreList{$what};
+ &msg($who, "removed $what from the ignore list");
+ } else {
+ &status("unignore FAILED for $1 at $who's request");
+ &msg($who, "no entry for $1 on the ignore list");
+ }
+ return 'NOREPLY';
+ }
+
+ # clear unignore list.
+ if ($message =~ /^clear ignorelist$/i) {
+ return 'NOREPLY' unless (&hasFlag("o"));
+ undef %ignoreList;
+ &status("unignoring all ($who said the word)");
+
+ return 'NOREPLY';
+ }
+
+ # lobotomy. sometimes we want the bot to be _QUIET_.
+ if ($message =~ /^(lobotomy|bequiet)$/i) {
+ return 'NOREPLY' unless (&hasFlag("o"));
+
+ if ($lobotomized) {
+ &performReply("i'm already lobotomized");
+ } else {
+ &performReply("i have been lobotomized");
+ $lobotomized = 1;
+ }
+
+ return 'NOREPLY';
+ }
+
+ # unlobotomy.
+ if ($message =~ /^(unlobotomy|benoisy)$/i) {
+ return 'NOREPLY' unless (&hasFlag("o"));
+ if ($lobotomized) {
+ &performReply("i have been unlobotomized, woohoo");
+ $lobotomized = 0;
+ } else {
+ &performReply("i'm not lobotomized");
+ }
+ return 'NOREPLY';
+ }
+
+ # op.
+ if ($message =~ /^op(\s+(.*))?$/i) {
+ return 'NOREPLY' unless (&hasFlag("o"));
+ my ($opee) = lc $2;
+ my @chans;
+
+ if ($opee =~ / /) {
+ if ($opee =~ /^(\S+)\s+(\S+)$/) {
+ $opee = $1;
+ @chans = ($2);
+ if (!&validChan($2)) {
+ &msg($who,"error: invalid chan ($2).");
+ return 'NOREPLY';
+ }
+ } else {
+ &msg($who,"error: invalid params.");
+ return 'NOREPLY';
+ }
+ } else {
+ @chans = keys %channels;
+ }
+
+ my $found = 0;
+ my $op = 0;
+ foreach (@chans) {
+ next unless (&IsNickInChan($opee,$_));
+ $found++;
+ if ($channels{$_}{'o'}{$opee}) {
+ &status("op: $opee already has ops on $_");
+ next;
+ }
+ $op++;
+
+ &status("opping $opee on $_ at ${who}'s request");
+ &op($_, $opee);
+ }
+
+ if ($found != $op) {
+ &status("op: opped on all possible channels.");
+ } else {
+ &DEBUG("found => '$found'.");
+ &DEBUG("op => '$op'.");
+ }
+
+ return 'NOREPLY';
+ }
+
+ # deop.
+ if ($message =~ /^deop(\s+(.*))?$/i) {
+ return 'NOREPLY' unless (&hasFlag("o"));
+ my ($opee) = lc $2;
+ my @chans;
+
+ if ($opee =~ / /) {
+ if ($opee =~ /^(\S+)\s+(\S+)$/) {
+ $opee = $1;
+ @chans = ($2);
+ if (!&validChan($2)) {
+ &msg($who,"error: invalid chan ($2).");
+ return 'NOREPLY';
+ }
+ } else {
+ &msg($who,"error: invalid params.");
+ return 'NOREPLY';
+ }
+ } else {
+ @chans = keys %channels;
+ }
+
+ my $found = 0;
+ my $op = 0;
+ foreach (@chans) {
+ next unless (&IsNickInChan($opee,$_));
+ $found++;
+ if (!exists $channels{$_}{'o'}{$opee}) {
+ &status("deop: $opee already has no ops on $_");
+ next;
+ }
+ $op++;
+
+ &status("deopping $opee on $_ at ${who}'s request");
+ &deop($_, $opee);
+ }
+
+ if ($found != $op) {
+ &status("deop: deopped on all possible channels.");
+ } else {
+ &DEBUG("deop: found => '$found'.");
+ &DEBUG("deop: op => '$op'.");
+ }
+
+ return 'NOREPLY';
+ }
+
+ # say.
+ if ($message =~ s/^say\s+(\S+)\s+(.*)//) {
+ return 'NOREPLY' unless (&hasFlag("o"));
+ my ($chan,$msg) = (lc $1, $2);
+ &DEBUG("chan => '$1', msg => '$msg'.");
+
+ if (&validChan($chan)) {
+ &msg($chan, $2);
+ } else {
+ &msg($who,"i'm not on \002$1\002, sorry.");
+ }
+ return 'NOREPLY';
+ }
+
+ # die.
+ if ($message =~ /^die$/) {
+ return 'NOREPLY' unless (&hasFlag("n"));
+
+ &doExit();
+
+ status("Dying by $who\'s request");
+ exit 0;
+ }
+
+ # jump.
+ if ($message =~ /^jump(\s+(\S+))?$/i) {
+ return 'NOREPLY' unless (&hasFlag("n"));
+
+ if ($2 eq "") {
+ &help("jump");
+ return 'NOREPLY';
+ }
+
+ my ($server,$port);
+ if ($2 =~ /^(\S+)(:(\d+))?$/) {
+ $server = $1;
+ $port = $3 || 6667;
+ } else {
+ &msg($who,"invalid format.");
+ return 'NOREPLY';
+ }
+
+ &status("jumping servers... $server...");
+ &rawout("QUIT :jumping to $server");
+
+ if (&irc($server,$port) == 0) {
+ &ircloop();
+ }
+ }
+
+ # reload.
+ if ($message =~ /^reload$/i) {
+ return 'NOREPLY' unless (&hasFlag("n"));
+
+ &status("USER reload $who");
+ &msg($who,"reloading...");
+ &reloadModules();
+ &msg($who,"reloaded.");
+
+ return 'NOREPLY';
+ }
+
+ # rehash.
+ if ($message =~ /^rehash$/) {
+ return 'NOREPLY' unless (&hasFlag("n"));
+
+ &msg($who,"rehashing...");
+ &restart("REHASH");
+ &status("USER rehash $who");
+ &msg($who,"rehashed");
+
+ return 'NOREPLY';
+ }
+
+ # set.
+ if ($message =~ /^set(\s+(\S+)?(\s+(.*))?)?$/i) {
+ return 'NOREPLY' unless (&hasFlag("n"));
+ my ($param,$what) = ($2,$4);
+
+ if ($param eq "" and $what eq "") {
+ &msg($who,"\002Usage\002: set <param> [what]");
+ return 'NOREPLY';
+ }
+
+ if (!exists $param{$param}) {
+ &msg($who,"error: param{$param} cannot be set");
+ return 'NOREPLY';
+ }
+
+ if ($what eq "") {
+ if ($param{$param} eq "") {
+ &msg($who,"param{$param} has \002no value\002.");
+ } else {
+ &msg($who,"param{$param} has value of '\002$param{$param}\002'.");
+ }
+ return 'NOREPLY';
+ }
+
+ if ($param{$param} eq $what) {
+ &msg($who,"param{$param} already has value of '\002$what\002'.");
+ return 'NOREPLY';
+ }
+
+ $param{$param} = $what;
+ &msg($who,"setting param{$param} to '\002$what\002'.");
+
+ return 'NOREPLY';
+ }
+
+ # unset.
+ if ($message =~ /^unset(\s+(\S+))?$/i) {
+ return 'NOREPLY' unless (&hasFlag("n"));
+ my ($param) = $2;
+
+ if ($param eq "") {
+ &msg($who,"\002Usage\002: unset <param>");
+ return 'NOREPLY';
+ }
+
+ if (!exists $param{$param}) {
+ &msg($who,"error: \002$param\002 cannot be unset");
+ return 'NOREPLY';
+ }
+
+ if ($param{$param} == 0) {
+ &msg($who,"\002param{$param}\002 has already been unset.");
+ return 'NOREPLY';
+ }
+
+ $param{$param} = 0;
+ &msg($who,"unsetting \002param{$param}\002.");
+
+ return 'NOREPLY';
+ }
+
+ # more...
+}
+
+1;
--- /dev/null
+#
+# UserInfo.pl: User Information Services
+# Author: xk <xk@leguin.openprojects.net>
+# Version: v0.1 (20000509).
+# Created: 20000509
+# NOTE: Idea from Flugh. Originally written in tcl for eggdrop by
+# unknown.
+#
+
+use strict;
+
+my $orderOfInfo = "RN,J,C,W,D";
+my %infoDesc = (
+ "RN" => "Real Name",
+ "J" => "Occupation",
+ "C" => "Contact",
+ "W" => "URL",
+ "D" => "Description",
+);
+
+sub UserInfo2Hash {
+ my ($text) = @_;
+ my %hash;
+
+ foreach (split /\|/, $text) {
+ if (/^\s*(\S+):\s*(.*)\s*$/) {
+ $hash{$1} = $2;
+ }
+ }
+
+ return %hash;
+}
+
+sub Hash2UserInfo {
+ my (%hash) = @_;
+ my @array;
+
+ foreach (sort keys %hash) {
+ push(@array, "$_: $hash{$_}");
+ }
+
+ join('|', @array);
+}
+
+###
+###
+###
+
+sub UserInfoGet {
+ my ($query) = @_;
+ $query =~ s/^\s+|\s+$//g if (defined $query);
+
+ if (!defined $query or $query =~ /^$/) {
+ &help("userinfo");
+ return;
+ }
+
+ if ($query !~ /^$mask{nick}$/) {
+ &msg($who, "Invalid query of '$query'.");
+ return;
+ }
+
+ my $result;
+ if ($result = &getFactoid($query." info")) {
+ # good.
+ } else { # bad.
+ &performReply("No User Information on \002$query\002");
+ return;
+ }
+
+ if ($result !~ /\|/) {
+ &msg($who, "Invalid User Information for '$query'.");
+ return;
+ }
+
+ my %userInfo = &UserInfo2Hash($result);
+
+ my @reply;
+ foreach (split ',', $orderOfInfo) {
+ next unless (exists $userInfo{$_});
+ push(@reply, "$infoDesc{$_}: $userInfo{$_}");
+ }
+
+ &performStrictReply("User Information on $userInfo{'N'} -- ".
+ join(', ', @reply));
+}
+
+sub UserInfoSet {
+ my($type, $what) = @_;
+ my %userInfo;
+ my $info;
+
+ if (&IsLocked("$who info")) {
+ &DEBUG("UIS: IsLocked('$who info') == 1.");
+ return;
+ }
+
+ my $new = 0;
+ if (my $result = &getFactoid("$who info")) {
+ %userInfo = &UserInfo2Hash($result);
+ } else {
+ &DEBUG("UIS: new = 1!");
+ $userInfo{'N'} = $who;
+ $new = 1;
+ }
+
+ ### TODO: hash for %infoS2L.
+ if ($type =~ /^(RN|real\s*name)$/i) {
+ $info = 'RN';
+ } elsif ($type =~ /^(J|job|occupation|school|life)$/i) {
+ $info = 'J';
+ } elsif ($type =~ /^(C|contact|email|phone)$/i) {
+ $info = 'C';
+ } elsif ($type =~ /^(W|www|url|web\s*page|home\s*page)$/i) {
+ $info = 'W';
+ } elsif ($type =~ /^(D|desc\S+)$/i) {
+ $info = 'D';
+ } elsif ($type =~ /^(O|opt\S+)$/i) {
+ $info = 'O';
+ } else {
+ &msg($who, "Unknown type '$type'.");
+ return;
+ }
+
+ if (!defined $what) { # !defined.
+ if (exists $userInfo{$info}) {
+ &msg($who, "Current \002$infoDesc{$info}\002 is: '$userInfo{$info}'.");
+ } else {
+ &msg($who, "No current \002$infoDesc{$info}\002.");
+ }
+
+ my @remain;
+ foreach (split ',', $orderOfInfo) {
+ next if (exists $userInfo{$_});
+ push(@remain, $infoDesc{$_});
+ }
+ if (scalar @remain) {
+ ### TODO: show short-cut (identifier) aswell.
+ &msg($who, "Remaining slots to fill: ".join(' ', @remain));
+ } else {
+### &msg($who, "Personal Information completely filled. Good.");
+ }
+
+ return;
+ } elsif ($what =~ /^$/) { # defined but NULL. UNSET
+ if (exists $userInfo{$info}) {
+ &msg($who, "Unsetting \002$infoDesc{$info}\002 ($userInfo{$info}).");
+ delete $userInfo{$info};
+ } else {
+ &msg($who, "\002$infoDesc{$info}\002 is already empty!");
+ return;
+ }
+ } else { # defined.
+ if (exists $userInfo{$info}) {
+ &msg($who, "\002$infoDesc{$info}\002 was '$userInfo{$info}'.");
+ &msg($who, "Now is: '$what'.");
+ } else {
+ &msg($who, "\002$infoDesc{$info}\002 is now '$what'.");
+ }
+ $userInfo{$info} = $what;
+ }
+
+ &setFactInfo($who." info", "factoid_value", &Hash2UserInfo(%userInfo));
+ if ($new) {
+ &DEBUG("UIS: locking '$who info'.");
+ &DEBUG("UIS: nuh => '$nuh'.");
+ &setFactInfo("$who info", "locked_by", $nuh);
+ &setFactInfo("$who info", "locked_time", time());
+ }
+}
+
+1;
--- /dev/null
+# WWWSearch backend, with queries updating the is-db (optionally)
+# Uses WWW::Search::Google and WWW::Search
+# originally Google.pl, drastically altered.
+
+package W3Search;
+
+use strict;
+
+my $maxshow = 3;
+
+sub W3Search {
+ my ($where, $what, $type) = @_;
+ my $retval = "$where can't find \002$what\002";
+
+ return unless &main::loadPerlModule("WWW::Search");
+
+ my @matches = grep { lc($_) eq lc($where) ? $_ : undef } @main::W3Search_engines;
+ if (@matches) {
+ $where = shift @matches;
+ } else {
+ &main::msg($main::who, "i don't know how to check '$where'");
+ }
+
+ my $Search = new WWW::Search($where);
+ my $Query = WWW::Search::escape_query($what);
+ $Search->native_query($Query,
+# {
+# search_debug => 2,
+# search_parse_debug => 2,
+# }
+ );
+ $Search->http_proxy($main::param{'httpProxy'}) if (&main::IsParam("httpProxy"));
+ my $max = $Search->maximum_to_retrieve(10); # DOES NOT WORK.
+
+ my ($Result, $count);
+ my $r;
+ ### TODO: don't duplicate hosts. minimize like with the files
+ ### function.
+ while ($r = $Search->next_result()) {
+ if ($Result) {
+ $Result .= " or ".$r->url();
+ } else {
+ $Result = $r->url();
+ }
+ last if ++$count >= $maxshow;
+ }
+
+ if ($Result) {
+ $retval = "$where says \002$what\002 is at $Result";
+ }
+
+ &main::performStrictReply($retval);
+}
+
+1;
--- /dev/null
+#
+# Wingate.pl: Wingate checker.
+# Author: xk <xk@leguin.openprojects.net>
+# Version: v0.3 (20000526).
+# Created: 20000116
+# NOTE: based on wingate.pl by fooz.
+#
+
+package Wingate;
+
+use strict;
+my $select = IO::Select->new;
+
+sub Wingates {
+ my $file = "$main::infobot_base_dir/$main::param{'ircUser'}.wingate";
+ my @hosts;
+
+ open(IN, $file);
+ while (<IN>) {
+ chop;
+ next if (/\*$/); # wingate. or forget about it?
+ push(@hosts,$_);
+ }
+ close IN;
+
+ foreach (@_) {
+ next if (grep /^$_$/, @hosts);
+
+ &main::DEBUG("W: _ => '$_'.");
+ &Wingate($_);
+ }
+}
+
+sub Wingate {
+ my ($host) = @_;
+
+ my $sock = IO::Socket::INET->new(
+ PeerAddr => $host,
+ PeerPort => 'telnet(23)',
+ Proto => 'tcp'
+### Timeout => 10, # enough :)
+ );
+
+ if (!defined $sock) {
+ &main::status("Wingate: connection refused to $host");
+ return;
+ }
+
+ $sock->timeout(10);
+ $select->add($sock);
+
+ my $errors = 0;
+ my ($luser);
+ foreach $luser ($select->can_read(1)) {
+ my $buf;
+ my $len = 0;
+ if (!defined($len = sysread($luser, $buf, 512))) {
+ &main::status("Wingate: connection lost to $luser/$host.");
+ $select->remove($luser);
+ close($luser);
+ next;
+ }
+
+ if ($len == 9) {
+ $len = sysread($luser, $buf, 512);
+ }
+
+ my $wingate = 0;
+ $wingate++ if ($buf =~ /^WinGate\>/);
+ $wingate++ if ($buf =~ /^Too many connected users - try again later$/);
+
+ if ($wingate) {
+ &main::status("Wingate: RUNNING ON $host BY $main::who.");
+
+ if (&main::IsParam("wingateBan")) {
+ &main::ban("*!*\@$host", "");
+ }
+
+ if (&main::IsParam("wingateKick")) {
+ &main::kick($main::who, "", $main::param{'wingateKick'});
+ }
+
+ push(@main::wingateBad, "$host\*");
+ &main::wingateWriteFile();
+ } else {
+### &main::DEBUG("no wingate.");
+ }
+
+ ### TODO: close telnet connection correctly!
+ $select->remove($luser);
+ close($luser);
+ }
+
+ return;
+}
+
+1;
--- /dev/null
+# This program is copyright Jonathan Feinberg 1999.
+
+# This program is distributed under the same terms as infobot.
+
+# Jonathan Feinberg
+# jdf@pobox.com
+# http://pobox.com/~jdf/
+
+# Version 1.0
+# First public release.
+
+package babel;
+use strict;
+
+BEGIN {
+ # Translate some feasible abbreviations into the ones babelfish
+ # expects.
+ use vars qw!%lang_code $lang_regex!;
+ %lang_code = (
+ 'fr' => 'fr',
+ 'sp' => 'es',
+ 'po' => 'pt',
+ 'pt' => 'pt',
+ 'it' => 'it',
+ 'ge' => 'de',
+ 'de' => 'de',
+ 'gr' => 'de',
+ 'en' => 'en'
+ );
+
+ # Here's how we recognize the language you're asking for. It looks
+ # like RTSL saves you a few keystrokes in #perl, huh?
+ $lang_regex = join '|', keys %lang_code;
+}
+
+sub babelfish {
+ my ($direction, $lang, $phrase) = @_;
+
+ return unless &loadPerlModule("URI::Escape");
+
+ $lang = $lang_code{$lang};
+
+ my $ua = new LWP::UserAgent;
+ $ua->timeout(10);
+
+ my $url = 'http://babelfish.altavista.digital.com/cgi-bin/translate';
+ my $req = HTTP::Request->new('POST',$url);
+ $req->content_type('application/x-www-form-urlencoded');
+
+ my $tolang = "en_$lang";
+ my $toenglish = "${lang}_en";
+
+ if ($direction eq 'to') {
+ &main::performStrictReply( translate($phrase, $tolang, $req, $ua) );
+ return;
+ } elsif ($direction eq 'from') {
+ &main::performStrictReply( translate($phrase, $toenglish, $req, $ua) );
+ return;
+ }
+
+ my $last_english = $phrase;
+ my $last_lang;
+ my %results = ();
+ my $i = 0;
+ while ($i++ < 7) {
+ last if $results{$phrase}++;
+ $last_lang = $phrase = translate($phrase, $tolang, $req, $ua);
+ last if $results{$phrase}++;
+ $last_english = $phrase = translate($phrase, $toenglish, $req, $ua);
+ }
+
+ &main::performStrictReply($last_english);
+}
+
+sub translate {
+ return '' if $no_babel;
+ my ($phrase, $languagepair, $req, $ua) = @_;
+
+ my $urltext = uri_escape($phrase);
+ $req->content("urltext=$urltext&lp=$languagepair&doit=done");
+
+ my $res = $ua->request($req);
+
+ my $translated;
+ if ($res->is_success) { # success.
+ my $html = $res->content;
+ # This method subject to change with the whims of Altavista's design
+ # staff.
+
+ $translated =
+ ($html =~ m{<br>
+ \s+
+ <font\ face="arial,\ helvetica">
+ \s*
+ (?:\*\*\s+time\ out\s+\*\*)?
+ \s*
+ ([^<]*)
+ }sx);
+
+ $translated =~ s/\n/ /g;
+ $translated =~ s/\s*$//;
+ } else { # failure
+ $translated = ":(";
+ }
+
+ return $translated;
+}
+
+1;
--- /dev/null
+#
+# insult.pl: insult engine
+# ???: ???
+#
+
+use strict;
+
+package Insult;
+
+sub Insult {
+ my ($insultwho) = @_;
+ return unless &loadPerlModule("Net::Telnet");
+
+ my $t = new Net::Telnet(Timeout => 3);
+ $t->Net::Telnet::open(Host => "insulthost.colorado.edu", Port => "1695");
+ my $line = $t->Net::Telnet::getline(Timeout => 4);
+
+ $line = "No luck, $main::who" unless (defined $line);
+
+ if ($insultwho ne $main::who) {
+ $line =~ s/^\s*You are/$insultwho is/i;
+ }
+
+ &performStrictReply($line);
+}
+
+1;
--- /dev/null
+#
+# Lame-o-Nickometer backend
+#
+# (c) 1998 Adam Spiers <adam.spiers@new.ox.ac.uk>
+#
+# You may do whatever you want with this code, but give me credit.
+#
+# $Id$
+#
+
+use strict;
+
+my $pi = 3.1415;
+my $score = 0;
+my $verbose = 0;
+
+sub nickometer ($) {
+ return unless &loadPerlModule("Getopt::Std");
+ return unless &loadPerlModule("Math::Trig");
+
+ local $_ = shift;
+ $score = 0;
+
+ if (!defined) {
+ &DEBUG("nickometer: arg == NULL.");
+ return;
+ }
+
+ # Deal with special cases (precede with \ to prevent de-k3wlt0k)
+ my %special_cost = (
+ '69' => 500,
+ 'dea?th' => 500,
+ 'dark' => 400,
+ 'n[i1]ght' => 300,
+ 'n[i1]te' => 500,
+ 'fuck' => 500,
+ 'sh[i1]t' => 500,
+ 'coo[l1]' => 500,
+ 'kew[l1]' => 500,
+ 'lame' => 500,
+ 'dood' => 500,
+ 'dude' => 500,
+ '[l1](oo?|u)[sz]er' => 500,
+ '[l1]eet' => 500,
+ 'e[l1]ite' => 500,
+ '[l1]ord' => 500,
+ 'pron' => 1000,
+ 'warez' => 1000,
+ 'xx' => 100,
+ '\[rkx]0' => 1000,
+ '\0[rkx]' => 1000,
+ );
+
+ foreach my $special (keys %special_cost) {
+ my $special_pattern = $special;
+ my $raw = ($special_pattern =~ s/^\\//);
+ my $nick = $_;
+ unless (defined $raw) {
+ $nick =~ tr/023457+8/ozeasttb/;
+ }
+ &punish($special_cost{$special}, "matched special case /$special_pattern/")
+ if (defined $nick and $nick =~ /$special_pattern/i);
+ }
+
+ # Allow Perl referencing
+ s/^\\([A-Za-z])/$1/;
+
+ # C-- ain't so bad either
+ s/^C--$/C/;
+
+ # Punish consecutive non-alphas
+ s/([^A-Za-z0-9]{2,})
+ /my $consecutive = length($1);
+ &punish(&slow_pow(10, $consecutive),
+ "$consecutive total consecutive non-alphas")
+ if $consecutive;
+ $1
+ /egx;
+
+ # Remove balanced brackets and punish for unmatched
+ while (s/^([^()]*) (\() (.*) (\)) ([^()]*) $/$1$3$5/x ||
+ s/^([^{}]*) (\{) (.*) (\}) ([^{}]*) $/$1$3$5/x ||
+ s/^([^\[\]]*) (\[) (.*) (\]) ([^\[\]]*) $/$1$3$5/x)
+ {
+ print "Removed $2$4 outside parentheses; nick now $_\n" if $verbose;
+ }
+ my $parentheses = tr/(){}[]/(){}[]/;
+ &punish(&slow_pow(10, $parentheses),
+ "$parentheses unmatched " .
+ ($parentheses == 1 ? 'parenthesis' : 'parentheses'))
+ if $parentheses;
+
+ # Punish k3wlt0k
+ my @k3wlt0k_weights = (5, 5, 2, 5, 2, 3, 1, 2, 2, 2);
+ for my $digit (0 .. 9) {
+ my $occurrences = s/$digit/$digit/g || 0;
+ &punish($k3wlt0k_weights[$digit] * $occurrences * 30,
+ $occurrences . ' ' .
+ (($occurrences == 1) ? 'occurrence' : 'occurrences') .
+ " of $digit")
+ if $occurrences;
+ }
+
+ # An alpha caps is not lame in middle or at end, provided the first
+ # alpha is caps.
+ my $orig_case = $_;
+ s/^([^A-Za-z]*[A-Z].*[a-z].*?)[_-]?([A-Z])/$1\l$2/;
+
+ # A caps first alpha is sometimes not lame
+ s/^([^A-Za-z]*)([A-Z])([a-z])/$1\l$2$3/;
+
+ # Punish uppercase to lowercase shifts and vice-versa, modulo
+ # exceptions above
+ my $case_shifts = &case_shifts($orig_case);
+ &punish(&slow_pow(9, $case_shifts),
+ $case_shifts . ' case ' .
+ (($case_shifts == 1) ? 'shift' : 'shifts'))
+ if ($case_shifts > 1 && /[A-Z]/);
+
+ # Punish lame endings (TorgoX, WraithX et al. might kill me for this :-)
+ &punish(50, 'last alpha lame') if $orig_case =~ /[XZ][^a-zA-Z]*$/;
+
+ # Punish letter to numeric shifts and vice-versa
+ my $number_shifts = &number_shifts($_);
+ &punish(&slow_pow(9, $number_shifts),
+ $number_shifts . ' letter/number ' .
+ (($number_shifts == 1) ? 'shift' : 'shifts'))
+ if $number_shifts > 1;
+
+ # Punish extraneous caps
+ my $caps = tr/A-Z/A-Z/;
+ &punish(&slow_pow(7, $caps), "$caps extraneous caps") if $caps;
+
+ # Now punish anything that's left
+ my $remains = $_;
+ $remains =~ tr/a-zA-Z0-9//d;
+ my $remains_length = length($remains);
+
+ &punish(50 * $remains_length + &slow_pow(9, $remains_length),
+ $remains_length . ' extraneous ' .
+ (($remains_length == 1) ? 'symbol' : 'symbols'))
+ if $remains;
+
+ print "\nRaw lameness score is $score\n" if $verbose;
+
+ # Use an appropriate function to map [0, +inf) to [0, 100)
+ my $percentage = 100 *
+ (1 + tanh(($score-400)/400)) *
+ (1 - 1/(1+$score/5)) / 2;
+
+ my $digits = 2 * (2 - &round_up(log(100 - $percentage) / log(10)));
+
+ return sprintf "%.${digits}f", $percentage;
+}
+
+sub case_shifts ($) {
+ # This is a neat trick suggested by freeside. Thanks freeside!
+
+ my $shifts = shift;
+
+ $shifts =~ tr/A-Za-z//cd;
+ $shifts =~ tr/A-Z/U/s;
+ $shifts =~ tr/a-z/l/s;
+
+ return length($shifts) - 1;
+}
+
+sub number_shifts ($) {
+ my $shifts = shift;
+
+ $shifts =~ tr/A-Za-z0-9//cd;
+ $shifts =~ tr/A-Za-z/l/s;
+ $shifts =~ tr/0-9/n/s;
+
+ return length($shifts) - 1;
+}
+
+sub slow_pow ($$) {
+ my ($x, $y) = @_;
+
+ return $x ** &slow_exponent($y);
+}
+
+sub slow_exponent ($) {
+ my $x = shift;
+
+ return 1.3 * $x * (1 - atan($x/6) *2/$pi);
+}
+
+sub round_up ($) {
+ my $float = shift;
+
+ return int($float) + ((int($float) == $float) ? 0 : 1);
+}
+
+sub punish ($$) {
+ my ($damage, $reason) = @_;
+
+ return unless $damage;
+
+ $score += $damage;
+ print "$damage lameness points awarded: $reason\n" if $verbose;
+}
+
+1;
--- /dev/null
+#
+# Net.pl: FTP//HTTP helper
+# Author: xk <xk@leguin.openprojects.net>
+# Version: v0.1 (20000309)
+# Created: 20000309
+#
+
+if (&IsParam("useStrict")) { use strict; }
+
+use vars qw(%ftp);
+
+# Usage: &ftpGet($host,$dir,$file,[$lfile]);
+sub ftpGet {
+ my ($host,$dir,$file,$lfile) = @_;
+ my $verbose_ftp = 1;
+
+ return unless &loadPerlModule("Net::FTP");
+
+ &status("FTP: opening connection to $host.") if ($verbose_ftp);
+ my $ftp = Net::FTP->new($host,
+ 'Timeout' => 600,
+ 'BlockSize' => 1024,
+ );
+
+ if ($@) {
+ &ERROR("FTP: $@.");
+ return;
+ }
+
+ # login.
+ if ($ftp->login()) {
+ &status("FTP: logged in successfully.") if ($verbose_ftp);
+ } else {
+ &status("FTP: login failed.");
+ $ftp->quit();
+ return 0;
+ }
+
+ # change directories.
+ if ($ftp->cwd($dir)) {
+ &status("FTP: changed dirs to $dir.") if ($verbose_ftp);
+ } else {
+ &status("FTP: cwd dir ($dir) does not exist.");
+ $ftp->quit();
+ return 0;
+ }
+
+ # get the size of the file.
+ my ($size, $lsize);
+ if ($size = $ftp->size($file)) {
+ &status("FTP: file size is $size") if ($verbose_ftp);
+ my $thisfile = $file || $lfile;
+ &DEBUG("lfile => '$lfile'.");
+ if ( -f $thisfile) {
+ $lsize = -s $thisfile;
+ if ($_ != $lsize) {
+ &status("FTP: local size is $lsize; downloading.") if ($verbose_ftp);
+ } else {
+ &status("FTP: same size; skipping.");
+ &system("touch $thisfile"); # lame hack.
+ $ftp->quit();
+ return 1;
+ }
+ }
+ } else {
+ &status("FTP: file does not exist.");
+ $ftp->quit();
+ return 0;
+ }
+
+ my $start_time = &gettimeofday();
+ if (defined $lfile) {
+ &status("FTP: getting $file as $lfile.") if ($verbose_ftp);
+ $ftp->get($file,$lfile);
+ } else {
+ &status("FTP: getting $file.") if ($verbose_ftp);
+ $ftp->get($file);
+ }
+ &DEBUG("FTP: remsize => '$size'.");
+ if (defined $lsize) {
+ &DEBUG("FTP: locsize => '$lsize'.");
+ if ($size != $lsize) {
+ &WARN("FTP: downloaded file seems truncated. FIXME.");
+ }
+ }
+
+ my $delta_time = &gettimeofday() - $start_time;
+ if ($delta_time > 0 and $verbose_ftp) {
+ &status(sprintf("FTP: %.02f sec to complete.", $delta_time));
+ my ($rateunit,$rate) = ("B", $size / $delta_time);
+ if ($rate > 1024) {
+ $rate /= 1024;
+ $rateunit = "kB";
+ }
+ &status(sprintf("FTP: %.01f ${rateunit}/sec.", $rate));
+ }
+
+ $ftp->quit();
+
+ return 1;
+}
+
+# Usage: &ftpList($host,$dir);
+sub ftpList {
+ my ($host,$dir) = @_;
+ my $verbose_ftp = 1;
+
+ return unless &loadPerlModule("Net::FTP");
+
+ &status("FTP: opening connection to $host.") if ($verbose_ftp);
+ my $ftp = Net::FTP->new($host,'Timeout'=>600);
+
+ if ($@) {
+ &ERROR("FTP: $@.");
+ return;
+ }
+
+ # login.
+ if ($ftp->login()) {
+ &status("FTP: logged in successfully.") if ($verbose_ftp);
+ } else {
+ &status("FTP: login failed.");
+ $ftp->quit();
+ return;
+ }
+
+ # change directories.
+ if ($ftp->cwd($dir)) {
+ &status("FTP: changed dirs to $dir.") if ($verbose_ftp);
+ } else {
+ &status("FTP: cwd dir ($dir) does not exist.");
+ $ftp->quit();
+ return;
+ }
+
+ &status("FTP: doing ls.") if ($verbose_ftp);
+ foreach ($ftp->dir()) {
+ # modes d uid gid size month day time file.
+ if (/^(\S+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+) (\S{3})\s+(\d+) \d+:\d+ (.*)$/) {
+ # name = size.
+ $ftp{$8} = $5;
+ } else {
+ &DEBUG("FTP: UNKNOWN => '$_'.");
+ }
+ }
+ &status("FTP: ls done. ". scalar(keys %ftp) ." entries.");
+ $ftp->quit();
+
+ return %ftp;
+}
+
+### LWP.
+# Usage: &getURL($url, [$post]);
+sub getURL {
+ my ($url,$post) = @_;
+ my ($ua,$res,$req);
+
+ return unless &loadPerlModule("LWP::UserAgent");
+
+ $ua = new LWP::UserAgent;
+ $ua->proxy('http', $param{'httpProxy'}) if &IsParam("httpProxy");
+
+ if (defined $post) {
+ $req = new HTTP::Request('POST',$url);
+ $req->content_type('application/x-www-form-urlencoded');
+ $req->content($post);
+ } else {
+ $req = new HTTP::Request('GET',$url);
+ }
+
+ &status("getURL: getting '$url'");
+ my $time = time();
+ $res = $ua->request($req);
+ my $size = length($res->content);
+ if ($size and time - $time) {
+ my $rate = int( $size/1000/(time - $time) );
+ &status("getURL: Done (took ".&Time2String(time - $time).", $rate k/sec)");
+ }
+
+ # return NULL upon error.
+ return unless ($res->is_success);
+
+ return(split '\n', $res->content);
+}
+
+sub getURLAsFile {
+ my ($url,$file) = @_;
+ my ($ua,$res,$req);
+
+ return unless &loadPerlModule("LWP::Simple");
+
+### PROXY NOT SUPPORTED WITH SIMPLE?
+### $ua->proxy('http', $param{'httpProxy'}) if &IsParam("httpProxy");
+ my $time = time();
+ &status("getURLAsFile: getting '$url' as '$file'");
+ my $retval = getstore($url, $file);
+ my $delta_time = time() - $time;
+ if ($delta_time) {
+ my $size = -s $file || 0;
+ my $rate = int($size / $delta_time / 1024);
+ &status("getURLAsFile: Done. ($rate kB/sec)");
+ }
+
+ return $retval;
+}
+
+1;
--- /dev/null
+# infobot :: Kevin Lenzo 1997-1999
+#
+# process the incoming message
+#
+
+if (&IsParam("useStrict")) { use strict; }
+
+sub process {
+ $learnok = 0; # Able to learn?
+ $talkok = 0; # Able to yap?
+ $force_public_reply = 0;
+
+ return 'X' if $who eq $ident; # self-message.
+ return 'addressedother set' if ($addressedother);
+
+ $talkok = ($param{'addressing'} =~ /^OPTIONAL$/i or $addressed);
+ $learnok = ($param{'learn'} =~ /^HUNGRY$/i or $addressed);
+
+ &shmFlush(); # hack.
+
+ # check if we have our head intact.
+ if ($lobotomized) {
+ if ($addressed and IsFlag("o") eq "o") {
+ &msg($who, "give me an unlobotomy.");
+ }
+ return 'LOBOTOMY';
+ }
+
+ # talkMethod.
+ if ($param{'talkMethod'} =~ /^PRIVATE$/i) {
+ if ($msgType =~ /public/ and $addressed) {
+ &msg($who, "sorry. i'm in 'PRIVATE' talkMethod mode ".
+ "while you sent a message to me ${msgType}ly.");
+
+ return 'TALKMETHOD';
+ }
+ }
+
+ # ignore.
+ if ($ignore) {
+ return 'IGNORE';
+ }
+
+ # join, must be done before outsider checking.
+ if ($message =~ /^join(\s+(.*))?\s*$/i) {
+ return 'join: not addr' unless ($addressed);
+
+ $2 =~ /^($mask{chan})(,(\S+))?/;
+ my($thischan, $key) = (lc $1, $3);
+ my $chankey = $thischan;
+ $chankey .= " $key" if (defined $key);
+
+ if ($thischan eq "") {
+ &help("join");
+ return;
+ }
+
+ # Thanks to Eden Li (tile) for the channel key patch
+ my @chans = split(/[\s\t]+/, $param{'join_channels'});
+ if (!grep /^$thischan$/i, @chans) {
+ if (&IsFlag("o") ne "o") {
+ &msg($who, "I am not allowed to join $thischan.");
+ return;
+ }
+ }
+
+ if (&validChan($thischan)) {
+ &msg($who,"I'm already on $thischan...");
+ return;
+ }
+ $joinverb{$thischan} = $who; # used for on_join self.
+
+ &joinchan($chankey);
+ &status("JOIN $chankey <$who>");
+ &msg($who, "joining $chankey");
+
+ return;
+ }
+
+ # allowOutsiders.
+ if (&IsParam("disallowOutsiders") and $msgType =~ /private/i) {
+ my $found = 0;
+
+ foreach (keys %channels) {
+ next unless (&IsNickInChan($who,$_));
+
+ $found++;
+ last;
+ }
+
+ if (!$found and scalar(keys %channels)) {
+ &status("OUTSIDER <$who> $message");
+ return 'OUTSIDER';
+ }
+ }
+
+ # User Processing, for all users.
+ return 'NOREPLY from userC' if &userCommands() eq 'NOREPLY';
+
+ ###
+ # once useless messages have been parsed out, we match them.
+ ###
+
+ # addressed.
+ if ($message =~ /^\Q$ident\E\s*\?*$/i) {
+ &status("feedback addressing from $who");
+
+ &performReply("yes?");
+
+ return;
+ }
+
+ # confused? is this for infobot communications?
+ foreach (keys %{$lang{'confused'}}) {
+ my $y = $_;
+
+ next unless ($message =~ /^\Q$y\E\s*/);
+ return 'CONFUSO';
+ }
+
+ # hello. [took me a while to fix this. -xk]
+ if ($orig{message} =~ /^(\Q$ident\E\S?[:, ]\S?)?\s*(h(ello|i( there)?|owdy|ey|ola))( \Q$ident\E)?\s*$/i) {
+ return '' unless ($talkok);
+
+ # 'mynick: hi' or 'hi mynick' or 'hi'.
+ &status("somebody said hello");
+
+ # 50% chance of replying to a random greeting when not addressed
+ if (!defined $5 and $addressed == 0 and rand() < 0.5) {
+ &status("not returning unaddressed greeting");
+ return;
+ }
+
+ # customized random message.
+ my $tmp = (rand() < 0.5) ? ", $who" : "";
+ &performStrictReply(&getRandom(keys %{$lang{'hello'}}) . $tmp);
+ return;
+ }
+
+ # greetings.
+ if ($message =~ /how (the hell )?are (ya|you)( doin\'?g?)?\?*$/) {
+ my $reply = &getRandom(keys %{$lang{'howareyou'}});
+
+ &performReply($reply);
+
+ return;
+ }
+
+ # praise.
+ if ($message =~ /you (rock|rewl|rule|are so+ coo+l)/ ||
+ $message =~ /(good (bo(t|y)|g([ui]|r+)rl))|(bot( |\-)?snack)/i)
+ {
+ return 'praise: no addr' unless ($addressed);
+
+ &status("random praise detected");
+
+ my $tmp = (rand() < 0.5) ? "thanks $who " : "";
+ &performStrictReply($tmp.":)");
+
+ return;
+ }
+
+ # thanks.
+ if ($message =~ /^than(ks?|x)( you)?( \S+)?/i) {
+ &DEBUG("thanks: talkok => '$talkok', addressed => '$addressed'.");
+ return 'thank: no addr' unless ($message =~ /$ident/ or $talkok);
+
+ &performReply( &getRandom(keys %{$lang{'welcome'}}) );
+ return;
+ }
+
+
+ ###
+ ### bot commands...
+ ###
+
+ # override msgType.
+ if ($msgType =~ /public/ and $message =~ s/^\+//) {
+ &status("found '+' flag; setting msgType to public.");
+ $force_public_reply++;
+ $msgType = 'public';
+ }
+
+
+ # karma. set...
+ if ($message =~ /^(\S+)(--|\+\+)\s*$/ and $addressed) {
+ return '' unless (&hasParam("karma"));
+
+ my($term,$inc) = (lc $1,$2);
+
+ if ($msgType !~ /public/i) {
+ &msg($who, "karma must be done in public!");
+ return;
+ }
+
+ if (lc($term) eq lc($who)) {
+ &msg($who, "please don't karma yourself");
+ return;
+ }
+
+ my $karma = &dbGet("karma", "nick",$term,"karma") || 0;
+ if ($inc eq '++') {
+ $karma++;
+ } else {
+ $karma--;
+ }
+
+ &dbSet("karma", "nick",$term,"karma",$karma);
+
+ return;
+ }
+
+ # here's where the external routines get called.
+ # if they return anything but null, that's the "answer".
+ if ($addressed) {
+ my $er = &Modules();
+ if ($er =~ /\S/) {
+ &performStrictReply($er) if ($er ne 'NOREPLY');
+ return 'SOMETHING 1';
+ }
+
+ ### FIXME: should this only apply to public messages?
+ if ($addrchar) {
+ &DEBUG("floodwho => '$floodwho'.");
+ delete $flood{$floodwho}{$message};
+ &status("short return due to unknown command.");
+ return 'ADDR CHAR';
+ }
+ }
+
+ if (&IsParam("factoids") and $param{'DBType'} =~ /^(mysql|pg|postgres|dbm)/i) {
+ &FactoidStuff();
+ } elsif ($param{'DBType'} =~ /^none$/i) {
+ return "NO FACTOIDS.";
+ } else {
+ &ERROR("INVALID FACTOID SUPPORT? ($param{'DBType'})");
+ &shutdown();
+ exit 0;
+ }
+}
+
+sub FactoidStuff {
+ # inter-infobot.
+ if ($msgType =~ /private/ and $message =~ s/^:INFOBOT://) {
+ ### identification.
+ &status("infobot <$nuh> identified") unless $infobots{$nuh};
+ $infobots{$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 = "<REPLY> 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 (defined $result) {
+ my $author = &getFactInfo($faqtoid, "created_by");
+ if (IsFlag("r") ne "r" && $author =~ /^\Q$who\E\!/i) {
+ &msg($who, "you don't have access to remove that factoid");
+ return;
+ }
+
+ return 'locked factoid' if (&IsLocked($faqtoid) == 1);
+
+ &status("forget: <$who> '$faqtoid' =is=> '$result'");
+ &delFactoid($faqtoid);
+
+ &performReply("i forgot $faqtoid");
+
+ $count{'Update'}++;
+ } else {
+ &performReply("i didn't have anything called '$faqtoid'");
+ }
+
+ 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;
+ }
+
+ # 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;
+ }
+
+ if (&getFactoid($faqtoid) eq "") {
+ &msg($who, "factoid \002$faqtoid\002 does not exist");
+ return;
+ }
+
+ if ($function eq "lock") {
+ &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) {
+ my $author = &getFactInfo($from, "created_by");
+ if (&IsFlag("m") and $author =~ /^\Q$who\E\!/i) {
+ &msg($who, "It's not yours to modify.");
+ return 'NOREPLY';
+ }
+
+ 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 {
+ &performReply("i didn't have anything called '$from'");
+ }
+ } 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) {
+ if (length $result > $param{'maxDataSize'}) {
+ &performReply("that's too long");
+ return;
+ }
+ &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'");
+ }
+
+ return;
+ }
+
+
+ # Fix up $message for question.
+ for ($message) {
+ # fix the string.
+ s/^hey([, ]+)where/where/i;
+ s/whois/who is/ig;
+ 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($message);
+
+ return 'result is NOREPLY' if ($result eq 'NOREPLY');
+
+ if (defined $result and $result ne "") { # question.
+ &status("question: <$who> $message");
+ $count{'Question'}++;
+ } elsif (&IsParam("perlMath") and $addressed) { # perl math.
+ &loadMyModule("perlMath");
+ my $newresult = &perlMath();
+
+ if (defined $newresult and $newresult ne "") {
+ $result = $newresult;
+ &status("math: <$who> $message => $result");
+ }
+ }
+
+ if ($result ne "") {
+ &performStrictReply($result);
+ return;
+ } else {
+ # 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 ($_ = &doStatement($message)) {
+ return;
+ }
+
+ if ($addressed) {
+ &status("unparseable: $message");
+ &performReply( &getRandom(keys %{$lang{'dunno'}}) );
+ $count{'Dunno'}++;
+ }
+ }
+}
+
+1;
--- /dev/null
+#
+# Shm.pl: Shared Memory stuff.
+# Author: xk <xk@leguin.openprojects.net>
+# Version: 20000201
+# Created: 20000124
+#
+
+if (&IsParam("useStrict")) { use strict; }
+
+sub openSHM {
+ my $IPC_PRIVATE = 0;
+ my $size = 2000;
+
+ if (defined( $_ = shmget($IPC_PRIVATE, $size, 0777) )) {
+ &status("Created shared memory (shm) key: [$_]");
+ return $_;
+ } else {
+ &ERROR("openSHM: failed.");
+ &ERROR("Please delete some shared memory with ipcs or ipcrm.");
+ exit 1;
+ }
+}
+
+sub closeSHM {
+ my ($key) = @_;
+ my $IPC_RMID = 0;
+
+ &status("Closed shared memory (shm) key: [$key]");
+ return shmctl($key, $IPC_RMID, 0);
+}
+
+sub shmRead {
+ my ($key) = @_;
+ my $position = 0;
+ my $size = 3*80;
+ my $retval = '';
+
+ if (shmread($key,$retval,$position,$size)) {
+ return $retval;
+ } else {
+ &ERROR("shmRead: failed: $!");
+ return '';
+ }
+}
+
+sub shmWrite {
+ my ($key, $str) = @_;
+ my $position = 0;
+ my $size = 80*3;
+
+ # NULL hack.
+ ### TODO: create shmClear to deal with this.
+ if ($str !~ /^$/) {
+ my $read = &shmRead($key);
+ $read =~ s/\0+//g;
+ $str = $read ."||". $str if ($read ne "");
+ }
+
+ if (!shmwrite($key,$str,$position,$size)) {
+ &ERROR("shmWrite: failed: $!");
+ }
+}
+
+#######
+# Helpers
+#
+
+# Usage: &addForked($name);
+# Return: 1 for success, 0 for failure.
+sub addForked {
+ my ($name) = @_;
+ my $forker_timeout = 360; # 6mins, in seconds.
+
+ foreach (keys %forked) {
+ my $time = time() - $forked{$_};
+ next unless ($time > $forker_timeout);
+
+ ### TODO: use &time2string()?
+ &WARN("Fork: looks like we lost '$_', executed $time ago.");
+ delete $forked{$_};
+ }
+
+ my $count = 0;
+ while (scalar keys %forked > 2) { # 2 or more == fail.
+ sleep 1;
+
+ if ($count > 3) { # 3 seconds.
+ my $list = join(', ', keys %forked);
+ if (defined $who) {
+ &msg($who, "already running ($list) => exceeded allowed forked processes count (1?).");
+ } else {
+ &status("Fork: I ran too many forked processes :) Giving up $name.");
+ }
+ return 0;
+ }
+
+ $count++;
+ }
+
+ if (exists $forked{$name}) {
+ my $time = $forked{$name};
+ if (time() - $forked{$name} > 900) { # stale fork > 15m.
+ &status("forked: forked{$name} presumably exited without notifying us.");
+ $forked{$name} = time();
+ return 1;
+ } else { # fresh fork.
+ &msg($who, "$name is already running ". &Time2String(time() - $forked{$name}));
+ return 0;
+ }
+ } else {
+ $forked{$name} = time();
+ $count{'Fork'}++;
+ return 1;
+ }
+}
+
+sub delForked {
+ my ($name) = @_;
+
+ if (exists $forked{$name}) {
+ my $timestr = &Time2String(time() - $forked{$name});
+ &status("fork: took $timestr for $name.");
+ &shmWrite($shm,"DELETE FORK $name");
+ return 1;
+ } else {
+ &ERROR("delForked: forked{$name} does not exist. should not happen.");
+ return 0;
+ }
+}
+
+1;
--- /dev/null
+#
+# originally by kevin lenzo.
+# revamped by the xk.
+#
+
+if (&IsParam("useStrict")) { use strict; }
+
+sub IsFlag {
+ my $flags = $_[0];
+ my ($ret, $f, $o) = "";
+ my @ind = split //, $flags;
+
+ $userHandle ||= "default";
+
+ &DEBUG("isFlag: userHandle == '$userHandle'.");
+
+ foreach $f (split //, $userList{$userHandle}{'flags'}) {
+ foreach $o (@ind) {
+ next unless ($f eq $o);
+
+ $ret = $f;
+ last;
+ }
+ }
+ $ret;
+}
+
+sub verifyUser {
+ my ($nick, $lnuh) = @_;
+# my ($n,$u,$h) = ($lnuh =~ /^(\S+)!(\S+)\@(\S+)$/);
+ my ($user,$m);
+ $userHandle = "default";
+
+ ### FIXME: THIS NEEDS TO BE FIXED TO RECOGNISE HOSTMASKS!!!
+ my $userinlist = "";
+ foreach $user (keys %userList) {
+ ### Hack for time being.
+ if (0) {
+ if ($user =~ /^\Q$nick\E$/i) {
+ &DEBUG("vU: setting uH => '$user'.");
+ $userHandle = $user;
+ last;
+ }
+ next;
+ } else {
+ $userinlist = $user if ($user =~ /^\Q$nick\E$/);
+ }
+
+ foreach $m (keys %{$userList{$user}{'mask'}}) {
+ $m =~ s/\?/./g;
+ $m =~ s/\*/.*?/g;
+ $m =~ s/([\@\(\)\[\]])/\\$1/g;
+
+ next unless ($lnuh =~ /^$m$/i);
+ &DEBUG("vUser: $lnuh matched masked ($m). Good!");
+
+ $userHandle = $user;
+ $userinlist = "";
+ last;
+ }
+ last if ($userHandle ne "");
+ }
+
+ if ($userinlist and $userHandle eq "") {
+ &DEBUG("vUser: user is in list but wrong host.");
+ $userHandle = $userinlist;
+ }
+
+ # seen.
+ if (&IsParam("seen") 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'}++;
+ }
+
+# $talkWho{$talkchannel} = $orig{who};
+# $talkWho = $orig{who};
+### FIXME HERE.
+ $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 = substr($encrypted, 0, 2);
+ if ($encrypted =~ /^\$\d\$(\w\w)\$/) {
+ $salt = $1;
+ }
+
+ 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;
+ }
+}
+
+1;
--- /dev/null
+#
+# UserExtra.pl: User Commands, Public.
+# Author: xk <xk@leguin.openprojects.net>
+# Version: v0.2b (20000707)
+# Created: 20000107
+#
+
+if (&IsParam("useStrict")) { use strict; }
+
+use vars qw($message $arg $qWord $verb $lobotomized);
+use vars qw(%channels %chanstats %cmdstats);
+
+sub userCommands {
+ return '' unless ($addressed);
+
+ # chaninfo. xk++.
+ if ($message =~ /^chan(stats|info)(\s+(\S+))?$/i) {
+ my $chan = lc $3;
+ my $mode;
+
+ if ($chan eq "") { # all channels.
+ my $count = 0;
+ my $i = keys %channels;
+
+ &performStrictReply(
+ "i am on \002$i\002 ". &fixPlural("channel",$i).
+ ": ". join(' ', sort keys %channels)
+ );
+
+ foreach $chan (keys %channels) {
+ # crappy debugging...
+ if ($chan =~ / /) {
+ &ERROR("bad channel: chan => '$chan'.");
+ }
+ $count += scalar(keys %{$channels{$chan}{''}});
+ }
+ &performStrictReply(
+ "i've cached \002$count\002 ".&fixPlural("user",$count).
+ " distributed over \002".scalar(keys %channels)."\002 ".
+ &fixPlural("channel",scalar(keys %channels))."."
+ );
+
+ return 'NOREPLY';
+ }
+
+ # channel specific.
+
+ if (&validChan($chan) == 0) {
+ &msg($who,"error: invalid channel \002$chan\002");
+ return 'NOREPLY';
+ }
+
+ # Step 1:
+ my @array;
+ foreach (sort keys %{$chanstats{$chan}}) {
+ my $int = $chanstats{$chan}{$_};
+ next unless ($int);
+
+ push(@array, "\002$int\002 ". &fixPlural($_,$int));
+ }
+ my $reply = "On \002$chan\002, there ".
+ &fixPlural("has",scalar(@array)). " been ".
+ &IJoin(@array);
+
+ # Step 1b: check channel inconstencies.
+ $chanstats{$chan}{'Join'} ||= 0;
+ $chanstats{$chan}{'SignOff'} ||= 0;
+ $chanstats{$chan}{'Part'} ||= 0;
+
+ my $delta_stats = $chanstats{$chan}{'Join'}
+ - $chanstats{$chan}{'SignOff'}
+ - $chanstats{$chan}{'Part'};
+
+ if ($delta_stats) {
+ my $total = scalar(keys %{$channels{$chan}{''}});
+ &status("chaninfo: join ~= signoff + part (drift of $delta_stats < $total).");
+
+ if ($delta_stats > $total) {
+ &ERROR("chaninfo: delta_stats exceeds total users.");
+ }
+ }
+
+ # Step 2:
+ undef @array;
+ my $type;
+ foreach ("v","o","") {
+ my $int = scalar(keys %{$channels{$chan}{$_}});
+ next unless ($int);
+
+ $type = "Voice" if ($_ eq "v");
+ $type = "Opped" if ($_ eq "o");
+ $type = "Total" if ($_ eq "");
+
+ push(@array,"\002$int\002 $type");
+ }
+ $reply .= ". At the moment, ". &IJoin(@array);
+
+ # Step 3:
+ ### TODO: what's wrong with the following?
+ my %new = map { $userstats{$_}{'Count'} => $_ } keys %userstats;
+ my($count) = (sort { $b <=> $a } keys %new)[0];
+ if ($count) {
+ $reply .= ". \002$new{$count}\002 has said the most with a total of \002$count\002 messages";
+ }
+ &performStrictReply("$reply.");
+
+ return 'NOREPLY';
+ }
+
+ # Command statistics.
+ if ($message =~ /^cmdstats$/i) {
+ my @array;
+
+ if (!scalar(keys %cmdstats)) {
+ &performReply("no-one has run any commands yet");
+ return 'NOREPLY';
+ }
+
+ my %countstats;
+ foreach (keys %cmdstats) {
+ $countstats{$cmdstats{$_}}{$_} = 1;
+ }
+
+ foreach (sort {$b <=> $a} keys %countstats) {
+ my $int = $_;
+ next unless ($int);
+
+ foreach (keys %{$countstats{$int}}) {
+ push(@array, "\002$int\002 of $_");
+ }
+ }
+ &performStrictReply("command usage include ". &IJoin(@array).".");
+
+ return 'NOREPLY';
+ }
+
+ # conversion: ascii.
+ if ($message =~ /^(asci*|chr) (\d+)$/) {
+ return '' unless (&IsParam("allowConv"));
+
+ $arg = $2;
+ if ($arg < 32) {
+ $arg += 64;
+ $result = "^".chr($arg);
+ } else {
+ $result = chr($2);
+ }
+ $result = "NULL" if ($arg == 0);
+
+ &performReply( sprintf("ascii %s is '%s'", $arg, $result) );
+ return 'NOREPLY';
+ }
+
+ # conversion: ord.
+ if ($message =~ /^ord (.)$/) {
+ return '' unless (&IsParam("allowConv"));
+
+ $arg = $1;
+ if (ord($arg) < 32) {
+ $arg = chr(ord($arg) + 64);
+ if ($arg eq chr(64)) {
+ $arg = 'NULL';
+ } else {
+ $arg = '^'.$arg;
+ }
+ }
+
+ &performReply( sprintf("'%s' is ascii %s", $arg, ord $1) );
+ return 'NOREPLY';
+ }
+
+ # hex.
+ if ($message =~ /^hex(\s+(.*))?$/i) {
+ my $arg = $2;
+
+ if (!defined $arg) {
+ &help("hex");
+ return 'NOREPLY';
+ }
+
+ if (length $arg > 80) {
+ &msg($who, "Too long.");
+ return 'NOREPLY';
+ }
+
+ my $retval;
+ foreach (split //, $arg) {
+ $retval .= sprintf(" %X", ord($_));
+ }
+
+ &performStrictReply("$arg is$retval");
+
+ return 'NOREPLY';
+ }
+
+ # crypt.
+ if ($message =~ /^crypt\s+(\S+)\s*(?:,| )\s*(\S+)/) {
+ # word salt.
+ &performStrictReply(crypt($1, $2));
+ return 'NOREPLY';
+ }
+
+ # Factoid extension info. xk++
+ if ($message =~ /^(factinfo)(\s+(.*))?$/i) {
+ my $query = "";
+ my $faqtoid = lc $3;
+
+ if ($faqtoid =~ /^\-(\S+)(\s+(.*))$/) {
+ &msg($who,"error: individual factoid info queries not supported as yet.");
+ &msg($who,"it's possible that the factoid mistakenly begins with '-'.");
+ return 'NOREPLY';
+
+ $query = lc $1;
+ $faqtoid = lc $3;
+ }
+
+ &loadMyModule($myModules{'factoids'});
+ &CmdFactInfo($faqtoid, $query);
+
+ $cmdstats{'Factoid Info'}++;
+ return 'NOREPLY';
+ }
+
+ # Factoid extension statistics. xk++
+ if ($message =~ /^(factstats?)(\s+(\S+))?$/i) {
+ my $type = $3;
+
+ if (!defined $type) {
+ &help("factstats");
+ return 'NOREPLY';
+ }
+
+ &Forker("factoids", sub {
+ &performStrictReply( &CmdFactStats($type) );
+ } );
+ $cmdstats{'Factoid Statistics'}++;
+ return 'NOREPLY';
+ }
+
+ # help.
+ if ($message =~ /^help(\s+(.*))?$/i) {
+ $cmdstats{'Help'}++;
+
+ &help($2);
+
+ return 'NOREPLY';
+ }
+
+ # karma.
+ if ($message =~ /^karma(\s+(\S+))?\??$/i) {
+ return '' unless (&IsParam("karma"));
+
+ my $target = lc $2 || lc $who;
+
+ my $karma = &dbGet("karma", "nick",$target,"karma") || 0;
+ if ($karma != 0) {
+ &performStrictReply("$target has karma of $karma");
+ } else {
+ &performStrictReply("$target has neutral karma");
+ }
+
+ return 'NOREPLY';
+ }
+
+ # ignorelist.
+ if ($message =~ /^ignorelist$/i) {
+ &status("$who asked for the ignore list");
+
+ my $time = time();
+ my $count = scalar(keys %ignoreList);
+ my $counter = 0;
+ my @array;
+
+ if ($count == 0) {
+ &performStrictReply("no one in the ignore list!!!");
+ return 'NOREPLY';
+ }
+
+ foreach (sort keys %ignoreList) {
+ my $str;
+
+ if ($ignoreList{$_} != 1) { # temporary ignore.
+ my $expire = $ignoreList{$_} - $time;
+ if (defined $expire and $expire < 0) {
+ &status("ignorelist: deleting $_.");
+ delete $ignoreList{$_};
+ } else {
+ $str = "$_ (". &Time2String($expire) .")";
+ }
+ } else {
+ $str = $_;
+ }
+
+ push(@array,$str);
+ $counter++;
+ if (scalar @array >= 8 or $counter == $count) {
+ &msg($who, &formListReply(0, "Ignore list ", @array) );
+ @array = ();
+ }
+ }
+
+ return 'NOREPLY';
+ }
+
+ # ispell.
+ if ($message =~ /^spell(\s+(.*))?$/) {
+ return '' unless (&IsParam("spell"));
+ my $query = $2;
+
+ if ($query eq "") {
+ &help("spell");
+ return 'NOREPLY';
+ }
+
+ if (! -x "/usr/bin/spell") {
+ &msg($who, "no binary found.");
+ return 'NOREPLY';
+ }
+
+ if (!&validExec($query)) {
+ &msg($who,"argument appears to be fuzzy.");
+ return 'NOREPLY';
+ }
+
+ my $reply = "I can't find alternate spellings for '$query'";
+
+ foreach (`echo '$query' | ispell -a -S`) {
+ chop;
+ last if !length; # end of query.
+
+ if (/^\@/) { # intro line.
+ next;
+ } elsif (/^\*/) { # possibly correct.
+ $reply = "'$query' may be spelled correctly";
+ last;
+ } elsif (/^\&/) { # possible correction(s).
+ s/^\& (\S+) \d+ \d+: //;
+ my @array = split(/,? /);
+
+ $reply = "possible spellings for $query: @array";
+ last;
+ } elsif (/^\+/) {
+ &DEBUG("spell: '+' found => '$_'.");
+ last;
+ } else {
+ &DEBUG("spell: unknown: '$_'.");
+ }
+ }
+
+ &performStrictReply($reply);
+
+ return 'NOREPLY';
+ }
+
+ # nslookup.
+ if ($message =~ /^(dns|nslookup)(\s+(\S+))?$/i) {
+ return '' unless (&IsParam("allowDNS"));
+
+ if ($3 eq "") {
+ &help("nslookup");
+ return 'NOREPLY';
+ }
+
+ &status("DNS Lookup: $3");
+ &loadMyModule($myModules{'allowDNS'});
+ &DNS($3);
+ return 'NOREPLY';
+ }
+
+ # cycle.
+ if ($message =~ /^(cycle)(\s+(\S+))?$/i) {
+ return 'NOREPLY' unless (&hasFlag("o"));
+ my $chan = lc $3;
+
+ if ($chan eq "") {
+ if ($msgType =~ /public/) {
+ $chan = $talkchannel;
+ &DEBUG("cycle: setting chan to '$chan'.");
+ } else {
+ &help("cycle");
+ return 'NOREPLY';
+ }
+ }
+
+ if (&validChan($chan) == 0) {
+ &msg($who,"error: invalid channel \002$chan\002");
+ return 'NOREPLY';
+ }
+
+ &msg($chan, "I'm coming back. (courtesy of $who)");
+ &part($chan);
+ sleep 3;
+ &joinchan($chan);
+
+ return 'NOREPLY';
+ }
+
+ # redir.
+ if ($message =~ /^redir(\s+(.*))?/i) {
+ return 'NOREPLY' unless (&hasFlag("o"));
+ my $factoid = $2;
+
+ if (!defined $factoid) {
+ &help("redir");
+ return 'NOREPLY';
+ }
+
+ my $val = &getFactInfo($factoid, "factoid_value");
+ if (!defined $val or $val eq "") {
+ &msg($who, "error: '$factoid' does not exist.");
+ return 'NOREPLY';
+ }
+ &DEBUG("val => '$val'.");
+ my @list = &searchTable("factoids", "factoid_key",
+ "factoid_value", "^$val\$");
+
+ if (scalar @list == 1) {
+ &msg($who, "hrm... '$factoid' is unique.");
+ return 'NOREPLY';
+ }
+ if (scalar @list > 5) {
+ &msg($who, "A bit too many factoids to be redirected, hey?");
+ return 'NOREPLY';
+ }
+
+ my @redir;
+ &status("Redirect '$factoid' (". ($#list) .")...");
+ for (@list) {
+ next if (/^\Q$factoid\E$/i);
+
+ &status(" Redirecting '$_'.");
+ my $was = &getFactoid($_);
+ &DEBUG(" was '$was'.");
+ push(@redir,$_);
+ &setFactInfo($_, "factoid_value", "<REPLY> see $factoid");
+ }
+ &status("Done.");
+
+ &msg($who, &formListReply(0, "'$factoid' is redirected to by '", @redir));
+
+ return 'NOREPLY';
+ }
+
+ # rot13 it.
+ if ($message =~ /^rot13(\s+(.*))?/i) {
+ my $reply = $2;
+
+ if ($reply eq "") {
+ &help("rot13");
+ return 'NOREPLY';
+ }
+
+ $reply =~ y/A-Za-z/N-ZA-Mn-za-m/;
+ &performStrictReply($reply);
+
+ return 'NOREPLY';
+ }
+
+ # ircstats.
+ if ($message =~ /^ircstats$/i) {
+ my $count = $ircstats{'ConnectCount'};
+ my $format_time = &Time2String(time() - $ircstats{'ConnectTime'});
+ my $reply;
+
+ ### RECONNECT COUNT.
+ if ($count == 1) { # good.
+ $reply = "I'm connected to $ircstats{'Server'} and have been so".
+ " for $format_time";
+ } else {
+ $reply = "Currently I'm hooked up to $ircstats{'Server'} but only".
+ " for $format_time. ".
+ "I had to reconnect \002$count\002 times.";
+ }
+
+ ### REASON.
+ my $reason = $ircstats{'DisconnectReason'};
+ if (defined $reason) {
+ $reply .= " I was last disconnected for '$reason'.";
+ }
+
+ &performStrictReply($reply);
+
+ return 'NOREPLY';
+ }
+
+ # status.
+ if ($message =~ /^statu?s$/i) {
+ my $startString = scalar(localtime $^T);
+ my $upString = &Time2String(time() - $^T);
+ my $count = &countKeys("factoids");
+
+ &performStrictReply(
+ "Since $startString, there have been".
+ " \002$count{'Update'}\002 ".
+ &fixPlural("modification", $count{'Update'}).
+ " and \002$count{'Question'}\002 ".
+ &fixPlural("question",$count{'Question'}).
+ " and \002$count{'Dunno'}\002 ".
+ &fixPlural("dunno",$count{'Dunno'}).
+ ". I have been awake for $upString this session, and ".
+ "currently reference \002$count\002 factoids. ".
+ "I'm using about \002$memusage\002 ".
+ "kB of memory."
+ );
+
+ return 'NOREPLY';
+ }
+
+ # tell.
+ if ($message =~ /^(tell|explain)(\s+(.*))?$/) {
+ return '' unless (&IsParam("allowTelling"));
+
+ my $args = $3;
+ if (!defined $args) {
+ &help("tell");
+ return 'NOREPLY';
+ }
+
+ my ($target, $tell_obj) = ('','');
+ my $reply;
+
+ # this one catches most of them
+ if ($message =~ /^tell\s+(\S+)\s+about\s+(.*)/i) {
+ $target = lc $1;
+ $tell_obj = $2;
+
+ # required for privmsg if excessive size.(??)
+ if ($target =~ /^us$/i) {
+ $target = $talkchannel;
+ } elsif ($target =~ /^(me|myself)$/i) {
+ $target = $who;
+ }
+
+ $tell_obj = $who if ($tell_obj =~ /^(me|myself)$/i);
+ $query = $tell_obj;
+ } elsif ($message =~ /tell\s+(\S+)\s+where\s+(\S+)\s+can\s+(\S+)\s+(.*)/i) {
+ # i'm sure this could all be nicely collapsed
+ $target = lc $1;
+ $tell_obj = $4;
+ $query = $tell_obj;
+
+ $target = "" if ($target =~ /^us$/i);
+ } elsif ($message =~ /tell\s+(\S+)\s+(what|where)\s+(.*?)\s+(is|are)[.?!]*$/i) {
+ $target = lc $1;
+ $qWord = $2;
+ $tell_obj = $3;
+ $verb = $4;
+ $query = "$qWord $verb $tell_obj";
+
+ $target = "" if ($target =~ /^us$/i);
+ } elsif ($message =~ /^(explain|tell)\s+(\S+)\s+to\s+(.*)$/i) {
+ $target = lc $3;
+ $tell_obj = $2;
+ $query = $tell_obj;
+ $target = "" if ($target =~ /^us$/i);
+ }
+ &status("target: $target query: $query");
+
+ # check target type. Deny channel targets.
+ if ($target !~ /^$mask{nick}$/ or $target =~ /^$mask{chan}$/) {
+ &msg($who,"No, $who, I won't.");
+ return 'NOREPLY';
+ }
+
+ # "intrusive".
+ if (!&IsNickInAnyChan($target)) {
+ &msg($who, "No, $target is not in any of my chans.");
+ return 'NOREPLY';
+ }
+
+ ### TODO: don't "tell" if sender is not in target's channel.
+
+ # self.
+ if ($target eq $ident) {
+ &msg($who, "Isn't that a bit silly?");
+ return 'NOREPLY';
+ }
+
+ # ...
+ my $result = &doQuestion($tell_obj);
+ return 'NOREPLY' if ($result eq "NOREPLY");
+
+ # no such factoid.
+ if ($result eq "") {
+ &msg($who, "i dunno what is '$tell_obj'.");
+ return 'NOREPLY';
+ }
+
+ # success.
+ &status("tell: <$who> telling $target about $tell_obj.");
+ if ($who ne $target) {
+ &msg($who, "told $target about $tell_obj ($result)");
+ $reply = "$who wants you to know: $result";
+ } else {
+ $reply = "telling yourself: $result";
+ }
+
+ &msg($target, $reply);
+
+ return 'NOREPLY';
+ }
+
+ # wantNick. xk++
+ if ($message =~ /^wantNick$/i) {
+ if ($param{'ircNick'} eq $ident) {
+ &msg($who, "no need to get my nick back since i have it ;)");
+ return 'NOREPLY';
+ }
+
+ my $str = "attempting to change nick to $param{'ircNick'}";
+ &status($str);
+ &msg($who, $str);
+
+ &nick($param{'ircNick'});
+ return 'NOREPLY';
+ }
+
+ # what else...
+}
+
+1;
--- /dev/null
+#
+# core.pl: Important functions stuff...
+# Author: xk <xk@leguin.openprojects.net>
+# Version: v0.4 (20000718)
+# Created: 20000322
+#
+
+use strict;
+
+# dynamic scalar. MUST BE REDUCED IN SIZE!!!
+### TODO: reorder.
+use vars qw(
+ $answer $correction_plausible $loggingstatus $talkchannel
+ $statcount $memusage $user $memusageOld $infobot_version $dbh
+ $shm $host $msg $infobot_misc_dir $infobot_pid $infobot_base_dir
+ $infobot_src_dir $conn $irc $learnok $nick $ident $no_syscall
+ $force_public_reply $addrchar $userHandle $addressedother
+ $floodwho $chan $msgtime $server $firsttime $wingaterun
+);
+
+# dynamic hash.
+use vars qw(@joinchan @ircServers @wingateBad @wingateNow @wingateCache
+);
+
+# dynamic hash. MUST BE REDUCED IN SIZE!!!
+use vars qw(%count %netsplit %netsplitservers %flood %dcc %orig
+ %nuh %talkWho %seen %floodwarn %param %dbh %ircPort %userList
+ %jointime %topic %joinverb %moduleAge %last %time %mask %file
+);
+
+# Signals.
+$SIG{'HUP'} = 'restart'; # 1.
+$SIG{'INT'} = 'doExit'; # 2.
+$SIG{'KILL'} = 'doExit'; # 9. DOES NOT WORK. 'man perlipc' for details.
+$SIG{'TERM'} = 'doExit'; # 15.
+$SIG{'__WARN__'} = 'doWarn';
+
+$last{buflen} = 0;
+$last{say} = "";
+$last{msg} = "";
+$userHandle = "default";
+$msgtime = time();
+$wingaterun = time();
+$firsttime = 1;
+$infobot_version = "blootbot 1.0.0 (20000725) -- $^O";
+
+##########
+### misc commands.
+###
+
+sub doExit {
+ my ($sig) = @_;
+
+ if (!defined $infobot_pid) { # independent.
+ exit 0;
+ } elsif ($infobot_pid == $$) { # parent.
+ &status("parent caught SIG$sig (pid $$).") if (defined $sig);
+
+ my $type;
+ &closeDCC();
+ &closePID();
+ &seenFlush();
+ &quit($param{'quitMsg'}) if (&whatInterface() =~ /IRC/);
+ &uptimeWriteFile();
+ &closeDB();
+ &closeSHM($shm);
+ &dumpallvars() if (&IsParam("dumpvarsAtExit"));
+ &closeLog();
+ } else { # child.
+ &status("child caught SIG$sig (pid $$).");
+ }
+
+ exit 0;
+}
+
+sub doWarn {
+ $SIG{__WARN__} = sub { warn $_[0]; };
+
+ foreach (@_) {
+ &WARN("PERL: $_");
+ }
+
+ $SIG{__WARN__} = 'doWarn';
+}
+
+# Usage: &IsParam($param);
+sub IsParam {
+ my $param = $_[0];
+
+ return 0 unless (defined $param);
+ return 0 unless (exists $param{$param});
+ return 0 unless ($param{$param});
+ return 0 if $param{$param} =~ /^false$/i;
+ return 1;
+}
+
+sub showProc {
+ my ($prefix) = $_[0] || "";
+
+ if (!open(IN, "/proc/$$/status")) {
+ &ERROR("cannot open '/proc/$$/status'.");
+ return;
+ }
+
+ if ($^O eq "linux") {
+ while (<IN>) {
+ $memusage = $1 if (/^VmSize:\s+(\d+) kB/);
+ }
+ close IN;
+
+ if (defined $memusageOld and &IsParam("DEBUG")) {
+ # it's always going to be increase.
+ my $delta = $memusage - $memusageOld;
+ if ($delta > 500) {
+ &status("MEM:$prefix increased by $delta kB. (total: $memusage kB)");
+ } elsif ($delta > 0) {
+ &status("MEM:$prefix increased by $delta kB.");
+ } elsif ($delta < 0) {
+ $delta = -$delta;
+ # never knew RSS could decrease, probably Size can't?
+ &status("MEM:$prefix decreased by $delta kB. YES YES YES");
+ }
+ }
+ $memusageOld = $memusage;
+ } else {
+ $memusage = "UNKNOWN";
+ }
+ ### TODO: FreeBSD/*BSD support.
+}
+
+######
+###### SETUP
+######
+
+sub setup {
+ &showProc(" (\&openLog before)");
+ &openLog(); # write, append.
+
+ # read.
+ &loadIgnore($infobot_misc_dir."/infobot.ignore");
+ &loadLang($infobot_misc_dir."/infobot.lang");
+ &loadIRCServers($infobot_misc_dir."/ircII.servers");
+ &loadUsers($infobot_misc_dir."/infobot.users");
+
+ $shm = &openSHM();
+ &openDB();
+
+ &status("Setup: ". &countKeys("factoids") ." factoids.");
+
+ &status("Initial memory usage: $memusage kB");
+}
+
+sub setupConfig {
+ &loadConfig($infobot_misc_dir."/infobot.config");
+
+ foreach ("ircNick", "ircUser", "ircName", "DBType") {
+ next if &IsParam($_);
+ &ERROR("Parameter $_ has not been defined.");
+ exit 1;
+ }
+
+ # static scalar variables.
+ $file{utm} = "$infobot_base_dir/$param{'ircUser'}.uptime";
+ $file{PID} = "$infobot_base_dir/$param{'ircUser'}.pid";
+}
+
+sub startup {
+ if (&IsParam("DEBUG")) {
+ &status("enabling debug diagnostics.");
+ ### I thought disabling this reduced memory usage by 1000 kB.
+ use diagnostics;
+ }
+
+ $count{'Question'} = 0;
+ $count{'Update'} = 0;
+ $count{'Dunno'} = 0;
+
+ &loadMyModulesNow();
+}
+
+sub shutdown {
+ # reverse order of &setup().
+ &closeDB();
+ &closeSHM($shm); # aswell. TODO: use this in &doExit?
+ &closeLog();
+}
+
+sub restart {
+ my ($sig) = @_;
+
+ if ($$ == $infobot_pid) {
+ &status("$sig called.");
+
+ ### crappy bug in Net::IRC?
+ if (!$conn->connected and time - $msgtime > 900) {
+ &status("reconnecting because of uncaught disconnect.");
+## $irc->start;
+ $conn->connect();
+ return;
+ }
+
+ &shutdown();
+ &loadConfig($infobot_misc_dir."/infobot.config");
+ &reloadModules() if (&IsParam("DEBUG"));
+ &setup();
+
+ &status("End of $sig.");
+ } else {
+ &status("$sig called; ignoring restart.");
+ }
+}
+
+# File: Configuration.
+sub loadConfig {
+ my ($file) = @_;
+
+ if (!open(FILE, $file)) {
+ &ERROR("FAILED loadConfig ($file): $!");
+ &status("Please make sure the configuration file exists.");
+ exit 1;
+ }
+
+ my $count = 0;
+ while (<FILE>) {
+ chomp;
+ next if /^\s*\#/;
+ next unless /\S/;
+ my ($set,$key,$val) = split(/\s+/, $_, 3);
+
+ if ($set ne "set") {
+ &status("loadConfig: invalid line '$_'.");
+ next;
+ }
+
+ # perform variable interpolation
+ $val =~ s/(\$(\w+))/$param{$2}/g;
+
+ $param{$key} = $val;
+
+ ++$count;
+ }
+ close FILE;
+
+ $file =~ s/^.*\///;
+ &status("Loaded config $file ($count items)");
+}
+
+1;
--- /dev/null
+#
+# db_dbm.pl: Extension on the factoid database.
+# OrigAuthor: Kevin Lenzo (c) 1997
+# CurrAuthor: xk <xk@leguin.openprojects.net>
+# Version: v0.6 (20000707)
+# FModified: 19991020
+#
+
+package main;
+
+if (&IsParam("useStrict")) { use strict; }
+
+use vars qw(%factoids %freshmeat %seen %rootwarn); # db hash.
+use vars qw(@factoids_format @rootwarn_format @seen_format);
+
+@factoids_format = (
+ "factoid_key",
+ "factoid_value",
+
+ "created_by",
+ "created_time",
+
+ "modified_by",
+ "modified_time",
+
+ "requested_by",
+ "requested_time",
+ "requested_count",
+
+ "locked_by",
+ "locked_time"
+);
+
+@freshmeat_format = (
+ "name",
+ "stable",
+ "devel",
+ "section",
+ "license",
+ "homepage",
+ "download",
+ "changelog",
+ "deb",
+ "rpm",
+ "link",
+ "oneliner",
+);
+
+@rootwarn_format = ("nick", "attempt", "time", "host", "channel");
+
+@seen_format = (
+ "nick",
+ "time",
+ "channel",
+ "host",
+ "messagecount",
+ "hehcount",
+ "karma",
+ "message"
+);
+
+my @dbm = ("factoids","freshmeat","rootwarn","seen");
+
+sub openDB {
+
+ foreach (@dbm) {
+ next unless (&IsParam($_));
+
+ my $file = "$param{'DBName'}-$_";
+
+ if (dbmopen(%{ $_ }, $file, 0644)) {
+ &status("Opened DBM $_ ($file).");
+ } else {
+ &ERROR("Failed open to DBM $_ ($file).");
+ &shutdown();
+ exit 1;
+ }
+ }
+}
+
+sub closeDB {
+
+ foreach (@dbm) {
+ next unless (&IsParam($_));
+
+ if (dbmclose(%{ $_ })) {
+ &status("Closed DBM $_ successfully.");
+ next;
+ }
+ &ERROR("Failed closing DBM $_.");
+ }
+}
+
+#####
+# Usage: &dbGet($table, $primkey, $primval, $select);
+sub dbGet {
+ my ($db, $key, $val, $select) = @_;
+ my $found = 0;
+ my @retval;
+ my $i;
+ &DEBUG("dbGet($db, $key, $val, $select);");
+
+ if (!scalar @{ "${db}_format" }) {
+ &ERROR("dG: no valid format layout for $db.");
+ return;
+ }
+
+ if (!defined ${ "$db" }{lc $val}) { # dbm hash exception.
+ &DEBUG("dbGet: '$val' does not exist in $db.");
+ return;
+ }
+
+ # return the whole row.
+ if ($select eq "*") {
+ return split $;, ${ "$db" }{lc $val};
+ } else {
+ &DEBUG("dbGet: select => '$select'.");
+ }
+
+ my @array = split "$;", ${ "$db" }{lc $val};
+ for (0 .. $#{ "${db}_format" }) {
+ my $str = ${ "${db}_format" }[$_];
+ next unless (grep /^$str$/, split(/\,/, $select));
+
+ $array[$_] ||= '';
+ &DEBUG("dG: pushing '$array[$_]'.");
+ push(@retval, $array[$_]);
+ }
+
+ if (scalar @retval > 1) {
+ return @retval;
+ } elsif (scalar @retval == 1) {
+ return $retval[0];
+ } else {
+ return;
+ }
+}
+
+#####
+# Usage: &dbGetCol();
+sub dbGetCol {
+ &DEBUG("STUB: &dbGetCol();");
+}
+
+#####
+# Usage: &dbGetRowInfo();
+sub dbGetRowInfo {
+ my ($db) = @_;
+
+ if (scalar @{ "${db}_format" }) {
+ return @{ "${db}_format" };
+ } else {
+ &ERROR("dbGCI: invalid format name ($db) [${db}_format].");
+ return;
+ }
+}
+
+#####
+# Usage: &dbSet($db, $primkey, $primval, $key, $val);
+sub dbSet {
+ my ($db, $primkey, $primval, $key, $val) = @_;
+ my $found = 0;
+ &DEBUG("dbSet($db, $primkey, $primval, $key, $val);");
+
+ my $info = ${$db}{lc $primval}; # case insensitive.
+ my @array = ($info) ? split(/$;/, $info) : ();
+
+ # new entry.
+ if (!defined ${$db}{lc $primval}) {
+ # we assume primary key as first one. bad!
+ $array[0] = $primval; # case sensitive.
+ }
+
+ for (0 .. $#{ "${db}_format" }) {
+ $array[$_] ||= ''; # from undefined to ''.
+ next unless (${ "${db}_format" }[$_] eq $key);
+ &DEBUG("dbSet: Setting array[$_]($key) to '$val'.");
+ $array[$_] = $val;
+ $found++;
+ last;
+ }
+
+ if (!$found) {
+ &msg($who,"error: invalid element name \002$type\002.");
+ return 0;
+ }
+
+ &DEBUG("setting $primval => '".join('|', @array)."'.");
+ ${$db}{lc $primval} = join $;, @array;
+
+ return 1;
+}
+
+sub dbUpdate {
+ &DEBUG("STUB: &dbUpdate(@_); FIXME!!!");
+}
+
+sub dbInsert {
+ my ($db, $primkey, %hash) = @_;
+ my $found = 0;
+
+ my $info = ${$db}{lc $primkey} || ''; # primkey or primval?
+
+ if (!scalar @{ "${db}_format" }) {
+ &ERROR("dbI: array ${db}_format does not exist.");
+ return 0;
+ }
+
+ my $i;
+ my @array = split $;, $info;
+ for $i (0 .. $#{ "${db}_format" }) {
+ $array[$i] ||= '';
+
+ foreach (keys %hash) {
+ my $col = ${ "${db}_format" }[$i];
+ next unless ($col eq $_);
+
+ &DEBUG("dbI: setting $db->$primkey\{$col} => '$hash{$_}'.");
+ $array[$i] = $hash{$_};
+ delete $hash{$_};
+ }
+ }
+
+ if (scalar keys %hash) {
+ &ERROR("dbI: not added...");
+ foreach (keys %hash) {
+ &ERROR("dbI: '$_' => '$hash{$_}'");
+ }
+ return 0;
+ }
+
+ ${$db}{lc $primkey} = join $;, @array;
+
+ return 1;
+}
+
+#####
+# Usage: &dbSetRow($db, @values);
+sub dbSetRow {
+ my ($db, @values) = @_;
+ my $key = lc $values[0];
+
+ if (!scalar @{ "${db}_format" }) {
+ &ERROR("dbSR: array ${db}_format does not exist.");
+ return 0;
+ }
+
+ if (defined ${$db}{$key}) {
+ &WARN("dbSetRow: $db {$key} already exists?");
+ }
+
+ if (scalar @values != scalar @{ "${db}_format" }) {
+ &WARN("dbSetRow: scalar values != scalar ${db}_format.");
+ }
+
+ for (0 .. $#{ "${db}_format" }) {
+ if (defined $array[$_] and $array[$_] ne "") {
+ &DEBUG("dbSetRow: array[$_] != NULL($array[$_]).");
+ }
+ $array[$_] = $values[$_];
+ }
+
+ ${$db}{$key} = join $;, @array;
+
+ &DEBUG("STUB: &dbSetRow(@_);");
+}
+
+#####
+# Usage: &dbDel($db, NULL, $primval);
+sub dbDel {
+ my ($db, $primkey, $primval) = @_;
+
+ if (!scalar @{ "${db}_format" }) {
+ &ERROR("dbD: array ${db}_format does not exist.");
+ return 0;
+ }
+
+ if (!defined ${$db}{lc $primval}) {
+ &WARN("dbDel: lc $primval does not exist in $db.");
+ } else {
+ delete ${$db}{lc $primval};
+ }
+
+ return '';
+}
+
+sub dbRaw {
+ &DEBUG("STUB: &dbRaw(@_);");
+}
+
+sub dbRawReturn {
+ &DEBUG("STUB: &dbRawReturn(@_);");
+}
+
+
+
+####################################################################
+##### Factoid related stuff...
+#####
+
+sub countKeys {
+ return scalar keys %{$_[0]};
+}
+
+sub getKeys {
+ &DEBUG("STUB: &getKeys(@_); -- REDUNDANT");
+}
+
+sub randKey {
+ &DEBUG("STUB: &randKey(@_);");
+}
+
+##### $select is misleading???
+# Usage: &searchTable($db, $returnkey, $primkey, $str);
+sub searchTable {
+ my ($db, $primkey, $key, $str) = @_;
+
+ if (!scalar @{ "${db}_format" }) {
+ &ERROR("sT: no valid format layout for $db.");
+ return;
+ }
+
+ my @results;
+ foreach (keys %{$db}) {
+ my $val = &dbGet($db, "NULL", $_, $key) || '';
+ next unless ($val =~ /\Q$str\E/);
+ push(@results, $_);
+ }
+
+ &DEBUG("sT: ".scalar(@results) );
+
+ @results;
+}
+
+#####
+# Usage: &getFactInfo($faqtoid, type);
+sub getFactInfo {
+ my ($faqtoid, $type) = @_;
+
+ if (!defined $factoids{$faqtoid}) { # dbm hash exception.
+ return;
+ }
+
+ if ($type eq "*") { # all.
+ return split /$;/, $factoids{$faqtoid};
+ }
+
+ # specific.
+ if (!grep /^$type$/, @factoids_format) {
+ &ERROR("gFI: type '$type' not valid for factoids.");
+ return;
+ }
+
+ my @array = split /$;/, $factoids{$faqtoid};
+ for (0 .. $#factoids_format) {
+ next unless ($type eq $factoids_format[$_]);
+ return $array[$_];
+ }
+
+ &ERROR("gFI: should never happen.");
+}
+
+#####
+# Usage: &getFactoid($faqtoid);
+sub getFactoid {
+ my ($faqtoid) = @_;
+
+ if (!defined $faqtoid or $faqtoid =~ /^\s*$/) {
+ &WARN("getF: faqtoid == NULL.");
+ return;
+ }
+
+ if (defined $factoids{$faqtoid}) { # dbm hash exception.
+ # we assume 1 unfortunately.
+ ### TODO: use &getFactInfo() instead?
+ my $retval = (split $;, $factoids{$faqtoid})[1];
+
+ if (defined $retval) {
+ &DEBUG("getF: returning '$retval' for '$faqtoid'.");
+ } else {
+ &DEBUG("getF: returning NULL for '$faqtoid'.");
+ }
+ return $retval;
+ } else {
+ return;
+ }
+}
+
+#####
+# Usage: &delFactoid($faqtoid);
+sub delFactoid {
+ my ($faqtoid) = @_;
+
+ if (!defined $faqtoid or $faqtoid =~ /^\s*$/) {
+ &WARN("delF: faqtoid == NULL.");
+ return;
+ }
+
+ if (defined $factoids{$faqtoid}) { # dbm hash exception.
+ delete $factoids{$faqtoid};
+ &status("DELETED $faqtoid");
+ } else {
+ &WARN("delF: nothing to deleted? ($faqtoid)");
+ return;
+ }
+}
+
+1;
--- /dev/null
+#
+# db_mysql.pl: MySQL database frontend.
+# Author: xk <xk@leguin.openprojects.net>
+# Version: v0.2c (19991224)
+# Created: 19991203
+#
+
+package main;
+
+if (&IsParam("useStrict")) { use strict; }
+
+sub openDB {
+ my $dsn = "DBI:mysql:$param{'DBName'}:$param{'SQLHost'}";
+ $dbh = DBI->connect($dsn, $param{'SQLUser'}, $param{'SQLPass'});
+
+ if ($dbh) {
+ &status("Opened MySQL connection to $param{'SQLHost'}");
+ } else {
+ &ERROR("cannot connect to $param{'SQLHost'}.");
+ &shutdown();
+ &closePID();
+ exit 1;
+ }
+}
+
+sub closeDB {
+ if (!$dbh) {
+ &WARN("closeDB: connection already closed?");
+ return 0;
+ }
+
+ &status("Closed MySQL connection to $param{'SQLHost'}.");
+ $dbh->disconnect();
+ return 1;
+}
+
+#####
+# Usage: &dbQuote($str);
+sub dbQuote {
+ return $dbh->quote($_[0]);
+}
+
+#####
+# Usage: &dbGet($table, $primkey, $primval, $select);
+sub dbGet {
+ my ($table, $primkey, $primval, $select) = @_;
+ my $query = "SELECT $select FROM $table WHERE $primkey=".
+ &dbQuote($primval);
+
+ my $sth;
+ if (!($sth = $dbh->prepare($query))) {
+ &ERROR("Get: $DBI::errstr");
+ return;
+ }
+
+ if (!$sth->execute) {
+ &ERROR("Get => '$query'");
+ &ERROR("Get => $DBI::errstr");
+ return;
+ }
+
+ my @retval = $sth->fetchrow_array;
+
+ $sth->finish;
+
+ if (scalar @retval > 1) {
+ return @retval;
+ } elsif (scalar @retval == 1) {
+ return $retval[0];
+ } else {
+ return;
+ }
+}
+
+#####
+# Usage: &dbGetCol($table, $primkey, $key, [$type]);
+sub dbGetCol {
+ my ($table, $primkey, $key, $type) = @_;
+ my $query = "SELECT $primkey,$key FROM $table WHERE $key IS NOT NULL";
+ my %retval;
+
+ my $sth = $dbh->prepare($query);
+ &ERROR("GetCol => '$query'") unless $sth->execute;
+
+ if (defined $type and $type == 1) {
+ while (my @row = $sth->fetchrow_array) {
+ # reverse it to make it easier to count.
+ $retval{$row[1]}{$row[0]} = 1;
+ }
+ } else {
+ while (my @row = $sth->fetchrow_array) {
+ $retval{$row[0]} = $row[1];
+ }
+ }
+
+ $sth->finish;
+
+ return %retval;
+}
+
+####
+# Usage: &dbGetRowInfo($table);
+sub dbGetRowInfo {
+ &DEBUG("STUB: dbGetRowInfo().");
+}
+
+#####
+# Usage: &dbSet($table, $primkey, $primval, $key, $val);
+sub dbSet {
+ my ($table, $primkey, $primval, $key, $val) = @_;
+ my $query;
+
+ my $result = &dbGet($table,$primkey,$primval,$primkey);
+ if (defined $result) {
+ $query = "UPDATE $table SET $key=".&dbQuote($val).
+ " WHERE $primkey=".&dbQuote($primval);
+ } else {
+ $query = "INSERT INTO $table ($primkey,$key) VALUES (".
+ &dbQuote($primval).",".&dbQuote($val).")";
+ }
+
+ &dbRaw("Set", $query);
+
+ return 1;
+}
+
+#####
+# Usage: &dbUpdate($table, $primkey, $primval, %hash);
+sub dbUpdate {
+ my ($table, $primkey, $primval, %hash) = @_;
+ my (@array);
+
+ foreach (keys %hash) {
+ push(@array, "$_=".&dbQuote($hash{$_}) );
+ }
+
+ &dbRaw("Update", "UPDATE $table SET ".join(', ', @array).
+ " WHERE $primkey=".&dbQuote($primval)
+ );
+
+ return 1;
+}
+
+#####
+# Usage: &dbInsert($table, $primkey, %hash);
+sub dbInsert {
+ my ($table, $primkey, %hash) = @_;
+ my (@keys, @vals);
+
+ foreach (keys %hash) {
+ push(@keys, $_);
+ push(@vals, &dbQuote($hash{$_}));
+ }
+
+ &dbRaw("Insert($table)", "INSERT INTO $table (".join(',',@keys).
+ ") VALUES (".join(',',@vals).")"
+ );
+
+ return 1;
+}
+
+#####
+# Usage: &dbSetRow($table, @values);
+sub dbSetRow {
+ my ($table, @values) = @_;
+
+ foreach (@values) {
+ $_ = &dbQuote($_);
+ }
+
+ return &dbRaw("SetRow", "INSERT INTO $table VALUES (".
+ join(",", @values) .")" );
+}
+
+#####
+# Usage: &dbDel($table, $primkey, $primval, [$key]);
+sub dbDel {
+ my ($table, $primkey, $primval, $key) = @_;
+
+ &dbRaw("Del", "DELETE FROM $table WHERE $primkey=".
+ &dbQuote($primval)
+ );
+
+ return 1;
+}
+
+# Usage: &dbRaw($prefix,$rawquery);
+sub dbRaw {
+ my ($prefix,$query) = @_;
+ my $sth;
+
+ if (!($sth = $dbh->prepare($query))) {
+ &ERROR("Raw($prefix): $DBI::errstr");
+ return 0;
+ }
+
+ if (!$sth->execute) {
+ &ERROR("Raw($prefix): => '$query'");
+ &ERROR("Raw($prefix): $DBI::errstr");
+ return 0;
+ }
+
+ $sth->finish;
+
+ return 1;
+}
+
+# Usage: &dbRawReturn($rawquery);
+sub dbRawReturn {
+ my ($query) = @_;
+ my @retval;
+
+ my $sth = $dbh->prepare($query);
+ &ERROR("RawReturn => '$query'.") unless $sth->execute;
+ while (my @row = $sth->fetchrow_array) {
+ push(@retval, $row[0]);
+ }
+ $sth->finish;
+
+ return @retval;
+}
+
+####################################################################
+##### Misc DBI stuff...
+#####
+
+#####
+# Usage: &countKeys($table);
+sub countKeys {
+ my ($table) = @_;
+
+ return (&dbRawReturn("SELECT count(*) FROM $table"))[0];
+}
+
+##### NOT USED.
+# Usage: &getKeys($table,$primkey);
+sub getKeys {
+ my ($table,$primkey) = @_;
+ my @retval;
+
+ my $query = "SELECT $primkey FROM $table";
+ my $sth = $dbh->prepare($query);
+
+ $sth->execute;
+ while (my @row = $sth->fetchrow_array) {
+ push(@retval, $row[0]);
+ }
+ $sth->finish;
+
+ return @retval;
+}
+
+#####
+# Usage: &randKey($table, $select);
+sub randKey {
+ my ($table, $select) = @_;
+ my $rand = int(rand(&countKeys($table) - 1));
+ my $query = "SELECT $select FROM $table LIMIT $rand,1";
+
+ my $sth = $dbh->prepare($query);
+ $sth->execute;
+ my @retval = $sth->fetchrow_array;
+ $sth->finish;
+
+ return @retval;
+}
+
+#####
+# Usage: &deleteTable($table);
+sub deleteTable {
+ &dbRaw("deleteTable($_[0])", "DELETE FROM $_[0]");
+}
+
+# Usage: &searchTable($table, $select, $key, $str);
+sub searchTable {
+ my($table, $select, $key, $str) = @_;
+ my $origStr = $str;
+ my @results;
+
+ # allow two types of wildcards.
+ if ($str =~ /^\^(.*)\$$/) {
+ &DEBUG("searchTable: should use dbGet(), heh.");
+ $str = $1;
+ } else {
+ $str .= "%" if ($str =~ s/^\^//);
+ $str = "%".$str if ($str =~ s/\$$//);
+ $str = "%".$str."%" if ($str eq $origStr); # el-cheapo fix.
+ }
+
+ $str =~ s/\_/\\_/g;
+ $str =~ s/\?/\_/g; # '.' should be supported, too.
+ # end of string fix.
+
+ my $query = "SELECT $select FROM $table WHERE $key LIKE ".
+ &dbQuote($str);
+ my $sth = $dbh->prepare($query);
+ $sth->execute;
+
+ while (my @row = $sth->fetchrow_array) {
+ push(@results, $row[0]);
+ }
+ $sth->finish;
+
+ return @results;
+}
+
+####################################################################
+##### Factoid related stuff...
+#####
+
+#####
+# Usage: &getFactInfo($faqtoid, type);
+sub getFactInfo {
+ return &dbGet("factoids", "factoid_key", $_[0], $_[1]);
+}
+
+#####
+# Usage: &getFactoid($faqtoid);
+sub getFactoid {
+ return &getFactInfo($_[0], "factoid_value");
+}
+
+#####
+# Usage: &delFactoid($faqtoid);
+sub delFactoid {
+ my ($faqtoid) = @_;
+
+ &dbDel("factoids", "factoid_key",$faqtoid);
+ &status("DELETED $faqtoid");
+
+ return 1;
+}
+
+1;
--- /dev/null
+#
+# db_pgsql.pl: PostgreSQL database frontend.
+# Author: xk <xk@leguin.openprojects.net>
+# Version: v0.1 (20000629)
+# Created: 20000629
+#
+
+if (&IsParam("useStrict")) { use strict; }
+
+sub openDB {
+ $dbh = Pg::connectdb("dbname=$param{'DBName'}");
+# $dbh = Pg::setdbLogin($param{'SQLHost'}, , , , $param{'DBName'},
+# $param{'SQLUser'}, $param{'SQLPass'});
+
+ if (PGRES_CONNECTION_OK eq $dbh->status) {
+ &status("Opened pgSQL connection to $param{'SQLHost'}");
+ } else {
+ &ERROR("cannot connect to $param{'SQLHost'}.");
+ &ERROR("pgSQL: ".$dbh->errorMessage);
+ &closeSHM($shm);
+ &closeLog();
+ exit 1;
+ }
+}
+
+sub closeDB {
+ if (!$dbh) {
+ &WARN("closeDB: connection already closed?");
+ return 0;
+ }
+
+ &status("Closed pgSQL connection to $param{'SQLHost'}.");
+ $dbh->disconnect();
+ return 1;
+}
+
+#####
+# Usage: &dbQuote($str);
+sub dbQuote {
+ $_[0] =~ s/\'/\\\\'/g;
+ return "'$_[0]'";
+}
+
+#####
+# Usage: &dbGet($table, $primkey, $primval, $select);
+sub dbGet {
+ my ($table, $primkey, $primval, $select) = @_;
+ my $query = "SELECT $select FROM $table WHERE $primkey=".
+ &dbQuote($primval);
+
+ my $res = $dbh->exec($query);
+ if (PGRES_TUPLES_OK ne $res->resultStatus) {
+ &ERROR("Get: $dbh->errorMessage");
+ return;
+ }
+
+ if (!$sth->execute) {
+ &ERROR("Get => '$query'");
+ &ERROR("Get => $DBI::errstr");
+ return;
+ }
+
+ my @retval = $res->fetchrow;
+
+ if (scalar @retval > 1) {
+ return @retval;
+ } elsif (scalar @retval == 1) {
+ return $retval[0];
+ } else {
+ return;
+ }
+}
+
+#####
+# Usage: &dbGetCol($table, $primkey, $key, [$type]);
+sub dbGetCol {
+ my ($table, $primkey, $key, $type) = @_;
+ my $query = "SELECT $primkey,$key FROM $table WHERE $key IS NOT NULL";
+ my %retval;
+
+ my $sth = $dbh->prepare($query);
+ &ERROR("GetCol => '$query'") unless $sth->execute;
+
+ if (defined $type and $type == 1) {
+ while (my @row = $sth->fetchrow_array) {
+ # reverse it to make it easier to count.
+ $retval{$row[1]}{$row[0]} = 1;
+ }
+ } else {
+ while (my @row = $sth->fetchrow_array) {
+ $retval{$row[0]} = $row[1];
+ }
+ }
+
+ $sth->finish;
+
+ return %retval;
+}
+
+#####
+# Usage: &dbSet($table, $primkey, $primval, $key, $val);
+sub dbSet {
+ my ($table, $primkey, $primval, $key, $val) = @_;
+ my $query;
+
+ my $result = &dbGet($table,$primkey,$primval,$primkey);
+ if (defined $result) {
+ $query = "UPDATE $table SET $key=".&dbQuote($val).
+ " WHERE $primkey=".&dbQuote($primval);
+ } else {
+ $query = "INSERT INTO $table ($primkey,$key) VALUES (".
+ &dbQuote($primval).",".&dbQuote($val).")";
+ }
+
+ &dbRaw("Set", $query);
+
+ return 1;
+}
+
+#####
+# Usage: &dbUpdate($table, $primkey, $primval, $key, $val);
+sub dbUpdate {
+ my ($table, $primkey, $primval, $key, $val) = @_;
+
+ &dbRaw("Update", "UPDATE $table SET $key=".&dbQuote($val).
+ " WHERE $primkey=".&dbQuote($primval)
+ );
+
+ return 1;
+}
+
+#####
+# Usage: &dbInsert($table, $primkey, $primval, $key, $val);
+sub dbInsert {
+ my ($table, $primkey, $primval, $key, $val) = @_;
+
+ &dbRaw("Insert", "INSERT INTO $table ($primkey,$key) VALUES (".
+ &dbQuote($primval).",".&dbQuote($val).")"
+ );
+
+ return 1;
+}
+
+#####
+# Usage: &dbSetRow($table, @values);
+sub dbSetRow {
+ my ($table, @values) = @_;
+
+ foreach (@values) {
+ $_ = &dbQuote($_);
+ }
+
+ return &dbRaw("SetRow", "INSERT INTO $table VALUES (".
+ join(",", @values) .")" );
+}
+
+#####
+# Usage: &dbDel($table, $primkey, $primval, [$key]);
+sub dbDel {
+ my ($table, $primkey, $primval, $key) = @_;
+
+ &dbRaw("Del", "DELETE FROM $table WHERE $primkey=".
+ &dbQuote($primval)
+ );
+
+ return 1;
+}
+
+# Usage: &dbRaw($prefix,$rawquery);
+sub dbRaw {
+ my ($prefix,$query) = @_;
+ my $sth;
+
+ my $res = $dbh->exec($query);
+ if (PGRES_COMMAND_OK ne $res->resultStatus) {
+ &ERROR("Raw($prefix): $dbh->errorMessage");
+ return 0;
+ }
+
+ &DEBUG("Raw: oid status => '$res->oidStatus'.");
+
+ if (!$sth->execute) {
+ &ERROR("Raw($prefix): => '$query'");
+ &ERROR("Raw($prefix): $DBI::errstr");
+ return 0;
+ }
+
+ $sth->finish;
+
+ return 1;
+}
+
+# Usage: &dbRawReturn($rawquery);
+sub dbRawReturn {
+ my ($query) = @_;
+ my @retval;
+
+ my $sth = $dbh->prepare($query);
+ &ERROR("RawReturn => '$query'.") unless $sth->execute;
+ while (my @row = $sth->fetchrow_array) {
+ push(@retval, $row[0]);
+ }
+ $sth->finish;
+
+ return @retval;
+}
+
+####################################################################
+##### Misc DBI stuff...
+#####
+
+#####
+# Usage: &countKeys($table);
+sub countKeys {
+ my ($table) = @_;
+
+ return (&dbRawReturn("SELECT count(*) FROM $table"))[0];
+}
+
+##### NOT USED.
+# Usage: &getKeys($table,$primkey);
+sub getKeys {
+ my ($table,$primkey) = @_;
+ my @retval;
+
+ my $query = "SELECT $primkey FROM $table";
+ my $sth = $dbh->prepare($query);
+
+ $sth->execute;
+ while (my @row = $sth->fetchrow_array) {
+ push(@retval, $row[0]);
+ }
+ $sth->finish;
+
+ return @retval;
+}
+
+#####
+# Usage: &randKey($table, $select);
+sub randKey {
+ my ($table, $select) = @_;
+ my $rand = int(rand(&countKeys($table) - 1));
+ my $query = "SELECT $select FROM $table LIMIT $rand,1";
+
+ my $sth = $dbh->prepare($query);
+ $sth->execute;
+ my @retval = $sth->fetchrow_array;
+ $sth->finish;
+
+ return @retval;
+}
+
+# Usage: &searchTable($table, $select, $key, $str);
+sub searchTable {
+ my($table, $select, $key, $str) = @_;
+ my $origStr = $str;
+ my @results;
+
+ # allow two types of wildcards.
+ if ($str =~ /^\^(.*)\$$/) {
+ &DEBUG("searchTable: should use dbGet(), heh.");
+ $str = $1;
+ } else {
+ $str .= "%" if ($str =~ s/^\^//);
+ $str = "%".$str if ($str =~ s/\$$//);
+ $str = "%".$str."%" if ($str eq $origStr); # el-cheapo fix.
+ }
+
+ $str =~ s/\_/\\_/g;
+ $str =~ s/\?/\_/g; # '.' should be supported, too.
+ # end of string fix.
+
+ my $query = "SELECT $select FROM $table WHERE $key LIKE ".
+ &dbQuote($str);
+ my $sth = $dbh->prepare($query);
+ $sth->execute;
+
+ while (my @row = $sth->fetchrow_array) {
+ push(@results, $row[0]);
+ }
+ $sth->finish;
+
+ return @results;
+}
+
+####################################################################
+##### Factoid related stuff...
+#####
+
+#####
+# Usage: &getFactInfo($faqtoid, [$what]);
+sub getFactInfo {
+ return &dbGet("factoids", "factoid_key", $_[0], $_[1]);
+}
+
+#####
+# Usage: &getFactoid($faqtoid);
+sub getFactoid {
+ return &getFactInfo($_[0], "factoid_value");
+}
+
+#####
+# Usage: &setFactInfo($faqtoid, $type, $what);
+sub setFactInfo {
+ &dbSet("factoids", "factoid_key", $_[0], $_[1], $_[2]);
+}
+
+sub delFactoid {
+ my ($faqtoid) = @_;
+
+ &dbDel("factoids", "factoid_key",$faqtoid);
+ &status("DELETED $faqtoid");
+
+ return 1;
+}
+
+1;
--- /dev/null
+#
+# interface.pl:
+#
+# Author:
+#
+
+### FIXME.
+#if (&IsParam("useStrict")) { use strict; }
+
+sub whatInterface {
+ if (!&IsParam("Interface") or $param{'Interface'} =~ /IRC/) {
+ return "IRC";
+ } else {
+ return "CLI";
+ }
+}
+
+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{'ircNick'};
+ $talkchannel = "#CLI";
+ $addressed = 1;
+
+ print ">>> ";
+ while (<STDIN>) {
+ $orig{message} = $_;
+ $_ = &process("local", 'public', $_);
+ print ">>> ";
+ }
+}
+
+1;
--- /dev/null
+#
+# logger.pl: logger functions!
+# Author: xk <xk@leguin.openprojects.net>
+# Version: 19991205
+# NOTE: Based on code by Kevin Lenzo & Patrick Cole (c) 1997
+#
+
+use strict;
+
+use vars qw($logDate $loggingstatus $statcount $infobot_pid
+ $statcountfix $addressed);
+use vars qw(@backlog);
+use vars qw(%param %file);
+
+require 5.001;
+
+my %attributes = (
+ 'clear' => 0,
+ 'reset' => 0,
+ 'bold' => 1,
+ 'underline' => 4,
+ 'underscore' => 4,
+ 'blink' => 5,
+ 'reverse' => 7,
+ 'concealed' => 8,
+ 'black' => 30, 'on_black' => 40,
+ 'red' => 31, 'on_red' => 41,
+ 'green' => 32, 'on_green' => 42,
+ 'yellow' => 33, 'on_yellow' => 43,
+ 'blue' => 34, 'on_blue' => 44,
+ 'magenta' => 35, 'on_magenta' => 45,
+ 'cyan' => 36, 'on_cyan' => 46,
+ 'white' => 37, 'on_white' => 47
+);
+
+use vars qw($b_black $_black $b_red $_red $b_green $_green
+ $b_yellow $_yellow $b_blue $_blue $b_magenta $_magenta
+ $b_cyan $_cyan $b_white $_white $_reset $_bold $ob $b);
+
+$b_black = cl('bold black'); $_black = cl('black');
+$b_red = cl('bold red'); $_red = cl('red');
+$b_green = cl('bold green'); $_green = cl('green');
+$b_yellow = cl('bold yellow'); $_yellow = cl('yellow');
+$b_blue = cl('bold blue'); $_blue = cl('blue');
+$b_magenta = cl('bold magenta'); $_magenta = cl('magenta');
+$b_cyan = cl('bold cyan'); $_cyan = cl('cyan');
+$b_white = cl('bold white'); $_white = cl('white');
+$_reset = cl('reset'); $_bold = cl('bold');
+$ob = cl('reset'); $b = cl('bold');
+
+############################################################################
+# Implementation (attribute string form)
+############################################################################
+
+# Return the escape code for a given set of color attributes.
+sub cl {
+ my @codes = map { split } @_;
+ my $attribute = '';
+ foreach (@codes) {
+ $_ = lc $_;
+ unless (defined $attributes{$_}) { die "Invalid attribute name $_" }
+ $attribute .= $attributes{$_} . ';';
+ }
+ chop $attribute;
+ ($attribute ne '') ? "\e[${attribute}m" : undef;
+}
+
+# logging support.
+sub openLog {
+ return unless (&IsParam("logfile"));
+ $file{log} = $param{'logfile'};
+
+ if (&IsParam("logType") and $param{'logType'} =~ /DAILY/i) {
+ my ($day,$month,$year) = (localtime(time()))[3,4,5];
+ $logDate = sprintf("%04d%02d%02d",$year+1900,$month+1,$day);
+ $file{log} .= "-".$logDate;
+ }
+
+ if (open(LOG, ">>$file{log}")) {
+ &status("Opened logfile $file{log}.");
+ LOG->autoflush(1);
+ $loggingstatus = 1;
+ } else {
+ &status("cannot open logfile $file{log}; disabling.");
+ $loggingstatus = 0;
+ }
+}
+
+sub closeLog {
+ # lame fix for paramlogfile.
+ return unless (&IsParam("logfile"));
+ return unless ($loggingstatus);
+
+ $loggingstatus = 0;
+ &status("Closed logfile ($file{log}).");
+ close LOG;
+}
+
+#####
+# Usage: &compress($file);
+sub compress {
+ my ($file) = @_;
+ my @compress = ("/usr/bin/bzip2","/bin/gzip");
+ my $okay = 0;
+
+ if (! -f $file) {
+ # ironically this does not get logged :)
+ &WARN("compress: file ($file) does not exist.");
+ return 0;
+ }
+
+ if (-f "$file.gz" or -f "$file.bz2") {
+ &WARN("compress: file.(gz|bz2) already exists.");
+ return 0;
+ }
+
+ foreach (@compress) {
+ next unless ( -x $_);
+
+ &status("Compressing '$file' with $_.");
+ system("$_ $file &");
+ $okay++;
+ last;
+ }
+
+ if (!$okay) {
+ &ERROR("no compress program found.");
+ return 0;
+ }
+
+ return 1;
+}
+
+sub DEBUG {
+ return unless (&IsParam("DEBUG"));
+
+ &status("${b_green}!DEBUG!$ob $_[0]");
+}
+
+sub ERROR {
+ &status("${b_red}!ERROR!$ob $_[0]");
+}
+
+sub WARN {
+ return unless (&IsParam("WARN"));
+
+ &status("${b_yellow}!WARN!$ob $_[0]");
+}
+
+sub FIXME {
+ &status("${b_cyan}!FIXME!$ob $_[0] (SHOULD NOT HAPPEN)");
+}
+
+sub VERB {
+ if (!&IsParam("VERBOSITY")) {
+ # NOTHING.
+ } elsif ($param{'VERBOSITY'} eq "1" and $_[1] <= 1) {
+ &status($_[0]);
+ } elsif ($param{'VERBOSITY'} eq "2" and $_[1] <= 2) {
+ &status($_[0]);
+ }
+}
+
+sub status {
+ my($input) = @_;
+ my $status;
+
+ # return if input is null'ish.
+ return '' if ($input =~ /^\s*$/);
+ $input =~ s/\n+$//;
+ $input =~ s/\002|037//g; # bold,video,underline => remove.
+
+ # pump up the stats (or loglinenum).
+ $statcount++;
+
+ # fix style of output if process is child.
+ if (defined $infobot_pid and $$ != $infobot_pid and !defined $statcountfix) {
+ $statcount = 1;
+ $statcountfix = 1;
+ }
+
+ # for logging and non-ansi control.
+ if ($statcountfix) {
+ $status = "!$statcount! ".$input;
+ if ($statcount > 1000) {
+ print LOG "ERROR: FORKED PROCESS RAN AWAY; KILLING.\n";
+ exit 0;
+ }
+ } else {
+ $status = "[$statcount] ".$input;
+ }
+
+ if (&IsParam("backlog")) {
+ push(@backlog, $status); # append to end.
+ shift(@backlog) if (scalar @backlog > $param{'backlog'});
+ }
+
+ if (&IsParam("VERBOSITY")) {
+ if ($statcountfix) {
+ printf $_red."!%5d!".$ob." ", $statcount;
+ } else {
+ printf $_green."[%5d]".$ob." ", $statcount;
+ }
+
+ # three uberstabs to Derek Moeller.
+ my $printable = $input;
+
+ if ($printable =~ s/^(<\/\S+>) //) {
+ # it's me saying something on a channel
+ my $name = $1;
+ print "$b_yellow$name $printable$ob\n";
+ } elsif ($printable =~ s/^(<\S+>) //) {
+ # public message on channel.
+ my $name = $1;
+
+ if ($addressed) {
+ print "$b_red$name $printable$ob\n";
+ } else {
+ print "$b_cyan$name$ob $printable$ob\n";
+ }
+
+ } elsif ($printable =~ s/^\* (\S+)\/(\S+) //) {
+ # public action.
+ print "$b_white*$ob $b_cyan$1$ob/$b_blue$2$ob $printable\n";
+ } elsif ($printable =~ s/^(-\S+-) //) {
+ # notice
+ print "$_green$1 $printable$ob\n";
+ } elsif ($printable =~ s/^(\* )?(\[\S+\]) //) {
+ # message/private action from someone
+ print "$b_white$1$ob" if (defined $1);
+ print "$b_red$2 $printable$ob\n";
+ } elsif ($printable =~ s/^(>\S+<) //) {
+ # i'm messaging someone
+ print "$b_magenta$1 $printable$ob\n";
+ } elsif ($printable =~ s/^(enter:|update:|forget:) //) {
+ # something that should be SEEN
+ print "$b_green$1 $printable$ob\n";
+ } else {
+ print "$printable\n";
+ }
+ }
+
+ # log the line into a file.
+ return unless (&IsParam("logfile"));
+ return unless ($loggingstatus);
+
+ # remove control characters from logging.
+ $input =~ s/\e\[[0-9;]+m//g;
+ $input =~ s/[\cA-\c_]//g;
+ $input = "FORK($$) ".$input if ($statcountfix);
+
+ my $date;
+ if (&IsParam("logType") and $param{'logType'} =~ /DAILY/i) {
+ $date = sprintf("%02d:%02d.%02d", (localtime(time()))[2,1,0]);
+
+ my ($day,$month,$year) = (localtime(time()))[3,4,5];
+ my $newlogDate = sprintf("%04d%02d%02d",$year+1900,$month+1,$day);
+ if (defined $logDate and $newlogDate != $logDate) {
+ &closeLog();
+ &compress($file{log});
+ &openLog();
+ }
+ } else {
+ $date = time();
+ }
+
+ print LOG sprintf("%s %s\n", $date, $input);
+}
+
+1;
--- /dev/null
+#
+# modules.pl: pseudo-Module handler
+# Author: xk <xk@leguin.openprojects.net>
+# Version: v0.2 (20000629)
+# Created: 20000624
+#
+
+if (&IsParam("useStrict")) { use strict; }
+
+###
+### REQUIRED MODULES.
+###
+
+eval "use IO::Socket";
+if ($@) {
+ &ERROR("no IO::Socket?");
+ exit 1;
+}
+&showProc(" (IO::Socket)");
+
+### MODULES.
+%myModules = (
+ "countdown" => "Countdown.pl",
+ "allowDNS" => "DNS.pl",
+ "debian" => "Debian.pl",
+ "debianExtra" => "DebianExtra.pl",
+ "dict" => "Dict.pl",
+ "dumpvars" => "DumpVars.pl",
+ "factoids" => "Factoids.pl",
+ "freshmeat" => "Freshmeat.pl",
+ "kernel" => "Kernel.pl",
+ "ircdcc" => "UserDCC.pl",
+ "perlMath" => "Math.pl",
+ "quote" => "Quote.pl",
+ "rootwarn" => "RootWarn.pl",
+ "search" => "Search.pl",
+ "slashdot" => "Slashdot3.pl",
+ "topic" => "Topic.pl",
+ "units" => "Units.pl",
+ "uptime" => "Uptime.pl",
+ "userinfo" => "UserInfo.pl",
+ "wwwsearch" => "W3Search.pl",
+ "whatis" => "WhatIs.pl",
+ "wingate" => "Wingate.pl",
+ "insult" => "insult.pl",
+ "nickometer" => "nickometer.pl",
+);
+@myModulesLoadNow = ('topic', 'uptime',);
+@myModulesReloadNot = ('IRC/Irc.pl','IRC/Schedulers.pl');
+
+sub loadCoreModules {
+ if (!opendir(DIR, $infobot_src_dir)) {
+ &ERROR("can't open source directory $infobot_src_dir: $!");
+ exit 1;
+ }
+
+ &status("Loading CORE modules...");
+
+ while (defined(my $file = readdir DIR)) {
+ next unless $file =~ /\.pl$/;
+ next unless $file =~ /^[A-Z]/;
+ my $mod = "$infobot_src_dir/$file";
+ ### TODO: use eval and exit gracefully?
+ require $mod;
+ $moduleAge{$mod} = (stat $mod)[9];
+ &showProc(" ($file)") if (&IsParam("DEBUG"));
+ }
+ closedir DIR;
+}
+
+sub loadDBModules {
+ &status("Loading DB modules...");
+
+ if ($param{'DBType'} =~ /^mysql$/i) {
+ eval "use DBI";
+ if ($@) {
+ &ERROR("libdbd-mysql-perl is not installed!");
+ exit 1;
+ }
+ &showProc(" (DBI // mysql)");
+
+ &status(" using MySQL support.");
+ require "$infobot_src_dir/db_mysql.pl";
+
+ } elsif ($param{'DBType'} =~ /^pgsql$/i) {
+ eval "use Pg";
+ if ($@) {
+ &ERROR("libpgperl is not installed!");
+ exit 1;
+ }
+ &showProc(" (Pg // postgreSQLl)");
+
+ &status(" using PostgreSQL support.");
+ require "$infobot_src_dir/db_pgsql.pl";
+ } elsif ($param{'DBType'} =~ /^dbm$/i) {
+
+ &status(" using Berkeley DBM 1.85/2.0 support.");
+ require "$infobot_src_dir/db_dbm.pl";
+ } else {
+
+ &status("DB support DISABLED.");
+ return;
+ }
+}
+
+sub loadFactoidsModules {
+ &status("Loading Factoids modules...");
+
+ if (!&IsParam("factoids")) {
+ &status("Factoid support DISABLED.");
+ return;
+ }
+
+ if (!opendir(DIR, "$infobot_src_dir/Factoids")) {
+ &ERROR("can't open source directory Factoids: $!");
+ exit 1;
+ }
+
+ while (defined(my $file = readdir DIR)) {
+ next unless $file =~ /\.pl$/;
+ next unless $file =~ /^[A-Z]/;
+ my $mod = "$infobot_src_dir/Factoids/$file";
+ ### TODO: use eval and exit gracefully?
+ require $mod;
+ $moduleAge{$mod} = (stat $mod)[9];
+ &showProc(" ($file)") if (&IsParam("DEBUG"));
+ }
+ closedir DIR;
+}
+
+sub loadIRCModules {
+ &status("Loading IRC modules...");
+ if (&whatInterface() =~ /IRC/) {
+ eval "use Net::IRC";
+ if ($@) {
+ &ERROR("libnet-irc-perl is not installed!");
+ exit 1;
+ }
+ &showProc(" (Net::IRC)");
+ } else {
+ &status("IRC support DISABLED.");
+ return;
+ }
+
+ if (!opendir(DIR, "$infobot_src_dir/IRC")) {
+ &ERROR("can't open source directory Factoids: $!");
+ exit 1;
+ }
+
+ while (defined(my $file = readdir DIR)) {
+ next unless $file =~ /\.pl$/;
+ next unless $file =~ /^[A-Z]/;
+ my $mod = "$infobot_src_dir/IRC/$file";
+ ### TODO: use eval and exit gracefully?
+ require $mod;
+ $moduleAge{$mod} = (stat $mod)[9];
+ &showProc(" ($file)") if (&IsParam("DEBUG"));
+ }
+ closedir DIR;
+}
+
+sub loadMyModulesNow {
+ my $loaded = 0;
+ my $total = 0;
+
+ &status("Loading MyModules...");
+ foreach (@myModulesLoadNow) {
+ $total++;
+
+ if (!exists $param{$_}) {
+ &DEBUG("myModule: $myModules{$_} not loaded.");
+ next;
+ }
+ &loadMyModule($myModules{$_});
+ $loaded++;
+ }
+
+ &status("Modules: Loaded/Total [$loaded/$total]");
+}
+
+### rename to modulesReload?
+sub reloadModules {
+## my @check = map { $myModules{$_} } keys %myModules;
+## push(@check, map { substr($_,2) } keys %moduleAge);
+ my @check = map { substr($_,2) } keys %moduleAge;
+
+ &DEBUG("rM: moduleAge must be in src/BLAH format?");
+ foreach (keys %moduleAge) {
+ &DEBUG("rM: moduleAge{$_} => '...'.");
+ }
+
+ foreach (@check) {
+ my $mod = $_;
+ my $file = (grep /\/$mod/, keys %INC)[0];
+
+ if (!defined $file) {
+ &DEBUG("rM: mod '$mod' was not found in \%INC.");
+ next;
+ }
+
+ if (! -f $file) {
+ &DEBUG("rM: file '$file' does not exist?");
+ next;
+ }
+
+ my $age = (stat $file)[9];
+ next if ($age == $moduleAge{$file});
+
+ if (grep /$mod/, @myModulesReloadNot) {
+ &DEBUG("rM: SHOULD NOT RELOAD $mod!!!");
+ next;
+ }
+
+ &DEBUG("rM: (loading) => '$mod' or ($_).");
+ delete $INC{$file};
+ eval "require \"$file\"";
+ if (@$) {
+ &DEBUG("rM: failure: @$");
+ } else {
+ &DEBUG("rM: good! (reloaded)");
+ }
+ }
+ &DEBUG("rM: Done.");
+}
+
+###
+### OPTIONAL MODULES.
+###
+
+local %perlModulesLoaded = ();
+local %perlModulesMissing = ();
+
+sub loadPerlModule {
+ return 0 if (exists $perlModulesMissing{$_[0]});
+ return 1 if (exists $perlModulesLoaded{$_[0]});
+
+ eval "use $_[0]";
+ if ($@) {
+ &WARN("Module: $_[0] is not installed!");
+ $perlModulesMissing{$_[0]} = 1;
+ return 0;
+ } else {
+ $perlModulesLoaded{$_[0]} = 1;
+ &status("Module: Loaded $_[0] ...");
+ &showProc(" ($_[0])");
+ return 1;
+ }
+}
+
+sub loadMyModule {
+ my ($tmp) = @_;
+ if (!defined $tmp) {
+ &WARN("loadMyModule: module is NULL.");
+ return 0;
+ }
+
+ my ($modulebase, $modulefile);
+ if (exists $myModules{$tmp}) {
+ ($modulename, $modulebase) = ($tmp, $myModules{$tmp});
+ } else {
+ $modulebase = $tmp;
+ }
+ my $modulefile = "$infobot_src_dir/Modules/$modulebase";
+
+ return 1 if (grep /$modulefile/, keys %INC);
+
+ if (! -f $modulefile) {
+ &ERROR("lMM: module ($modulebase) does not exist.");
+ if ($$ == $infobot_pid) { # parent.
+ &shutdown() if (defined $shm and defined $dbh);
+ } else { # child.
+ &delForked($modulename);
+ }
+
+ exit 1;
+ }
+
+ eval "require \"$modulefile\"";
+ if ($@) {
+ &ERROR("cannot load my module: $modulebase");
+ if ($infobot_pid == $$) { # parent.
+ &shutdown() if (defined $shm and defined $dbh);
+ } else { # child.
+ &delForked($modulebase);
+ }
+
+ exit 1;
+ } else {
+ $moduleAge{$modulefile} = (stat $modulefile)[9];
+ &DEBUG("lMM: setting moduleAge{$modulefile} = time();");
+
+ &status("myModule: Loaded $modulebase ...");
+ &showProc(" ($modulebase)");
+ return 1;
+ }
+}
+
+### this chews 3megs on potato, 300 kB on slink.
+$no_syscall = 0;
+###eval "require 'sys/syscall.ph'";
+#if ($@) {
+# &WARN("sys/syscall.ph has not been installed//generated. gettimeofday
+#will use time() instead");
+ $no_syscall = 1;
+#}
+#&showProc(" (syscall)");
+
+1;
projects / infobot.git / commitdiff