├── LICENSE ├── README.md ├── conf ├── infobot-are.txt ├── infobot-is.txt ├── infobot.channels ├── infobot.config-dist ├── infobot.crontab ├── infobot.help ├── infobot.help-dist ├── infobot.users ├── infobot.users-dist ├── magic8.txt ├── sane-are.txt ├── sane-ignore.txt └── sane-is.txt ├── doc ├── how_to_fix_files_uploaded_from_windows_to_unix.txt ├── infobot_guide.html ├── intro.bit └── makemanual.pl ├── extras ├── ANSI.pl ├── Aviation.pl ├── DNS.pl ├── Extras.pl ├── Internic.pl ├── Math.pl ├── NOAA.pl ├── RDF.pl ├── Slashdot3.pl ├── Speller.pl ├── Traceroute.pl ├── W3Search.pl ├── Zippy.pl ├── babel.pl ├── exchange.pl ├── excuse.pl ├── insult.pl ├── module-template ├── myRoutines.pl ├── nickometer.pl ├── purldoc.pl ├── stockquote.pl └── storeNickMessage.pl ├── infobot ├── scripts ├── README.scripts ├── curl ├── dump_db ├── flock-test ├── get_entries_from_log ├── make_password ├── make_snap ├── restore_snap ├── run_if_needed.pl ├── track2fact ├── unupdate_dbs └── update_db ├── src ├── CTCP.pl ├── Channel.pl ├── DBM.pl ├── Help.pl ├── Irc.pl ├── IrcExtras.pl ├── IrcHooks.pl ├── Misc.pl ├── Norm.pl ├── Params.pl ├── Process.pl ├── Question.pl ├── Reply.pl ├── Search.pl ├── Setup.pl ├── Statement.pl ├── Update.pl ├── User.pl ├── Util.pm └── w3c_utils.pl └── w3c.json /LICENSE: -------------------------------------------------------------------------------- 1 | 2 | Copyright (c) Kevin Lenzo, 1996-2000, except where noted 3 | otherwise. 4 | 5 | The Infobot is covered under the same terms as Perl itself 6 | (the Artistic License). This software is meant to be freely 7 | available under those terms in perpetuity. 8 | 9 | 10 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | # W3C's own infobot 3 | 4 | ## Introduction 5 | 6 | This bot is based on [infobot](http://www.infobot.org/), written by Kevin Lenzo . 7 | It adds the *inform* feature, which lets you leave a message to someone offline. 8 | 9 | ## Syntax 10 | 11 | ``` 12 | botie, inform [that|to|about] 13 | ``` 14 | 15 | * `inform` may also be any of these other keywords: 16 | `tell`, `notify`, `advise`, `alert`, `advise`, `enlighten`, `send word to`, `ping`, `remind`, `ask`, `beseech`, `beg` or `say`. 17 | * A comma after the nickname is OK, too. 18 | * `that`, `to` and `about` before the message are entirely optional. 19 | 20 | ## Examples 21 | 22 | ``` 23 | botie, alert joe123 that wings are on fire 24 | botie, ask laureen to please re-send the previous version of that doc 25 | botie, ping McNulty, The Bunks called! 26 | botie, inform susan32 Done! :) 27 | ``` 28 | 29 | ## Dependencies 30 | 31 | Perl 5 32 | 33 | -------------------------------------------------------------------------------- /conf/infobot-are.txt: -------------------------------------------------------------------------------- 1 | roses => red 2 | violets => blue 3 | -------------------------------------------------------------------------------- /conf/infobot-is.txt: -------------------------------------------------------------------------------- 1 | oznoid => at mailto:lenzo@cs.cmu.edu or at http://www.cs.cmu.edu/~lenzo 2 | infobot => at http://www.cs.cmu.edu/~infobot 3 | -------------------------------------------------------------------------------- /conf/infobot.channels: -------------------------------------------------------------------------------- 1 | # Channel File (c) 1999 Infobot & Associates 2 | 3 | ChannelEntry #test { 4 | fallback yes; 5 | addressing REQUIRE; 6 | shutup TRUE; 7 | msgonly TRUE; 8 | continuity 0; 9 | } 10 | 11 | -------------------------------------------------------------------------------- /conf/infobot.config-dist: -------------------------------------------------------------------------------- 1 | # parameter settings file for the infobot 2 | # kevin lenzo (lenzo@cs.cmu.edu) 3 | 4 | # note: 5 | # '$var' means a parameter that has been named; it is interpolated. 6 | # By convention, things with '.ext' (extensions) are text files, and 7 | # things with hyphens in them are DBM file prefixes, used for run-time 8 | # learning or state maintenance. 9 | # 10 | # Nota Bene: Comment out attributes you don't want. Note that the 11 | # word "false" is actually a true value! use 0 or comment 12 | # out options you don't want. 13 | 14 | # the internal name for this bot 15 | ident i-bot 16 | 17 | # the nickname we want 18 | wantNick $ident 19 | 20 | # the prefix of the dbm files 21 | dbname $ident 22 | 23 | # where to put logging info 24 | logfile $dbname.log 25 | 26 | # plusplus, an idea hijacked from CMU zephyr community, 27 | # and dkindred++ in particular. Otherwise known 28 | # as 'karma'. this is persistant between shutdowns. 29 | 30 | plusplus $dbname-karma 31 | 32 | # persistant "seen" db 33 | seen $dbname-seen 34 | 35 | # do we have an ignore database? uncomment this if not. 36 | ignore $dbname-ignore 37 | 38 | # inform messages database 39 | informdb $dbname-inform.db 40 | 41 | # should we ALWAYS close and reopen dbm on update? 42 | # some systems don't do commitment until quit. 43 | # 44 | # 0 => never force sync 45 | # 1 => force sync on every update 46 | # N => force sync every Nth update 47 | 48 | commitDBM 5 49 | 50 | # Explicitly set the database module. The default is AnyDBM_File. If 51 | # you want to use any shared database files (via sharedDBMs) you have to 52 | # set this to DB_File. 53 | 54 | DBMModule DB_File 55 | 56 | # Specify an extension which should be added to all database names. By 57 | # default this is empty. 58 | 59 | DBMExt .db 60 | 61 | # Specify which databases will be shared among multiple infobots on the 62 | # same machine, and so require locking. By default none are shared. If 63 | # you use this at all you have to set DBMModule to DB_File. This can be 64 | # a list of database names, or /all (which means every database), or 65 | # /all-but-ignore (which means every database except the ignore list). 66 | # 67 | # As of this writing, the databases are: 68 | # 69 | # is main database, for singular factoids 70 | # are main database, for plural factoids 71 | # ignore ignored nicks and user/host patterns 72 | # plusplus karma 73 | # seen last seen info by each nick 74 | 75 | #sharedDBMs is are plusplus 76 | #sharedDBMs /all 77 | #sharedDBMs /all-but-ignore 78 | 79 | # X is Y 80 | # max length of X (the key, 81 | # the 'left hand side' (LHS) of an assignment, 82 | # or the first argument) 83 | 84 | maxKeySize 50 85 | 86 | 87 | # max length of Y (value or data, the 'right hand side', or 2nd argument) 88 | maxDataSize 400 89 | 90 | # REQUIRE, OPTIONAL, REJECT for different behaviour with URLs 91 | # REQUIRE means it will need to be a url type (e.g. file:, http:) 92 | # OPTIONAL will take anything 93 | # REJECT will not accept any urls. this makes it easy to 94 | # run 2 with different nicks and styles. 95 | 96 | acceptUrl OPTIONAL 97 | 98 | # IRC-related params 99 | ircuser $ident 100 | realname $ident 101 | server irc.infobot.org 102 | port 6667 103 | allowed_channels #infobot #$ident #test 104 | 105 | # channels to join 106 | # use #channel,key (thanks to tile++) for keyed channels 107 | 108 | join_channels #infobot #$ident 109 | 110 | # server password, if needed 111 | # server_pass myserverpassword 112 | 113 | # vhost support... if you have a vhost, you can use this, 114 | # otherwise it won't work. 115 | # inm++, elph++ for this :) 116 | # vhost_name f00.bar.org 117 | 118 | # nickServ_pass foo 119 | # chanServ_pass bar 120 | 121 | # addressing is when you name the bot. if this is REQUIRE, 122 | # the bot should only speak when spoken to. BUT it may listen. 123 | # anything else will mean it can barge in when it thinks it 124 | # knows something. 125 | # "shutup" determines whether you can switch modes on the 126 | # fly with the bot. if you use REQUIRE for addressing, you 127 | # probably want to comment out the shutup line. 128 | 129 | addressing OPTIONAL 130 | # shutup TRUE 131 | 132 | # ansi screen control is available from 0.32 onwards 133 | # value of 1 means to use ANSI, 0 means generic bold 134 | ansi_control 1 135 | 136 | # things we may or may not want to allow. 1 = allow, 0 otherwise. 137 | # do you want to be a desktop calc? 138 | perlMath 1 139 | fortranMath 0 140 | 141 | # do you want to allow DNS lookup/Internic/Traceroute? 142 | allowDNS 1 143 | allowTraceroute 1 144 | allowInternic 1 145 | 146 | # ord/chr etc 147 | allowConv 1 148 | 149 | # tell so-and-so about such-and-such 150 | # allowTelling 1 151 | 152 | # let any old joe update stuff. if this is 0, you'll have to 153 | # either change some code, do everything with e.g. update_db, 154 | # or do something else arcane to get factoids in. 155 | allowUpdate 1 156 | 157 | # How much verbage to display on the console 158 | VERBOSITY 1 159 | 160 | # the magic hack word to unignore everyone 161 | unignoreWord unignore-everyone 162 | 163 | # where configuration and help files and such live, the default is the 164 | # files subdir of the main directory 165 | confdir conf 166 | 167 | # my help file. this will get confdir prepended 168 | # you may want to change this to $ident.help 169 | 170 | helpfile infobot.help 171 | 172 | srcdir src 173 | extradir extras 174 | 175 | # within how long of getting the same reply should 176 | # we not respond (irc mode only). in seconds. 177 | 178 | repeatIgnoreInterval 8 179 | 180 | # in what contexts do we let people make the bot leave a 181 | # channel (this is an or'd list; public private) 182 | 183 | allowLeave public 184 | 185 | # our user list default file (in miscdir) 186 | # you may want to change this to $ident.users 187 | 188 | userList infobot.users 189 | 190 | # channel list, specifies options which differ from the defaults, by 191 | # channel. 192 | 193 | channelList infobot.channels 194 | 195 | # default quit message 196 | quitMsg regrouping; bbiab 197 | 198 | 199 | # how long does something have to be before we'll just volunteer 200 | # the answer without a question mark, question, or being addressed 201 | minVolunteerLength 8 202 | 203 | # other bots to ask for help 204 | 205 | # friendlyBots url purl script mrapi 206 | 207 | # sane defines that ALWAYS overwrite existing values at startup 208 | # this is a prefix for the files (sane-is.txt, sane-are.txt) 209 | 210 | sanePrefix sane 211 | 212 | # allow weather and METAR lookups, respectively. These should 213 | # actually be turned into a user modes. mendel++. Require 214 | # LWP and metar requires Geo::METAR. 215 | # weather true 216 | # metar true 217 | 218 | # babelfish translator. jdf++. requires LWP, not included. 219 | # babel true 220 | 221 | # slashdot headlines. requires LWP, not included. get it from CPAN. 222 | # slash true 223 | 224 | # insult and excuse servers 225 | # insult true 226 | # excuse true 227 | 228 | # google search.. simon++ . expanded to www search using several 229 | # engines since it was so easy once you have WWW::Search. 230 | # use "update" if you want it to update the db, or comment 231 | # out if you don't want it. requires WWW::Search, not included. 232 | # use "forceupdate" to force a db update on every google search. 233 | wwwsearch update 234 | 235 | # general headline-getter. uses RDF. (LotR++) 236 | # rss true 237 | 238 | # purldoc perl documentation lookup DMasque++, HJ++ 239 | purldoc true 240 | purldoc_trigger purldoc 241 | purldoc_max_public 3 242 | 243 | # speller. requires the ispell program. 244 | ispell true 245 | 246 | #zippy quotes (infobot, yow or infobot, be zippy) 247 | zippy true 248 | 249 | # the magic 8ball (divine) 250 | magic8_answers $miscdir/magic8.txt 251 | 252 | # exchange rates (exchange 233 DEM to USD) 253 | # exchange true 254 | 255 | # stock quotes 256 | # stockquotes true 257 | 258 | -------------------------------------------------------------------------------- /conf/infobot.crontab: -------------------------------------------------------------------------------- 1 | */5 * * * * /usr/users/you/infobot0.1b/run_infobots.pl > /dev/null 2 | 3 | -------------------------------------------------------------------------------- /conf/infobot.help: -------------------------------------------------------------------------------- 1 | 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?" 2 | 3 | author: oznoid (mailto:lenzo@ri.cmu.edu) is my author. 4 | 5 | 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. 6 | corrections: You can add to an entry with "also". "X is also at ..." 7 | 8 | reply: There is a special tag, , that is used to override the usual response. Usually, a response is "X is Y", but it can be made "Y" by making the entry "X is Y". 9 | reply: This is a good way to close junk entries; use "X is " with nothing after it. 10 | 11 | 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. 12 | 13 | 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?" 14 | -------------------------------------------------------------------------------- /conf/infobot.help-dist: -------------------------------------------------------------------------------- 1 | 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?" 2 | 3 | author: oznoid (mailto:lenzo@ri.cmu.edu) is my author. 4 | 5 | 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. 6 | corrections: You can add to an entry with "also". "X is also at ..." 7 | 8 | reply: There is a special tag, , that is used to override the usual response. Usually, a response is "X is Y", but it can be made "Y" by making the entry "X is Y". 9 | reply: This is a good way to close junk entries; use "X is " with nothing after it. 10 | 11 | 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. 12 | 13 | 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?" 14 | -------------------------------------------------------------------------------- /conf/infobot.users: -------------------------------------------------------------------------------- 1 | # 2 | # User File (c) 1998 Infobot & Associates 3 | # 4 | # FLAGS 5 | # ---------------------- 6 | # i Ignored Flag 7 | # f MLF Usage Allowed 8 | # t Teaching Allowed 9 | # r Removing Allowed 10 | # m Modifying Allowed 11 | # c Part/Join Allowed 12 | # s Searching Allowed (possibly computationally expensive) 13 | # S user can make bot Say things 14 | # e Extra Privs [ not implemented robustly: AVOID ] 15 | # p oP on channel by public request 16 | # ---------------------- 17 | # o Owner Flag 18 | # ---------------------- 19 | # 20 | # recommended default user flags: +trmc 21 | 22 | UserEntry default { 23 | flags +trmcs; 24 | } 25 | 26 | # here's an example entry 27 | 28 | UserEntry oznoid { 29 | name "Kevin A. Lenzo"; 30 | title "that guy"; 31 | flags +ftrmcsSope; 32 | pass rrmrxB6U4ryRk; 33 | mask *!lenzo@*.speech.cs.cmu.edu; 34 | } 35 | 36 | UserEntry plonk { 37 | name "Eep Malloy" 38 | title "that guy II"; 39 | flags +trmcspo; 40 | pass rrmrxB6U4ryRk; 41 | mask *!*@*.static.telerama.com 42 | } 43 | -------------------------------------------------------------------------------- /conf/infobot.users-dist: -------------------------------------------------------------------------------- 1 | # 2 | # User File (c) 1998 Infobot & Associates 3 | # 4 | # FLAGS 5 | # ---------------------- 6 | # i Ignored Flag 7 | # f MLF Usage Allowed 8 | # t Teaching Allowed 9 | # r Removing Allowed 10 | # m Modifying Allowed 11 | # c Part/Join Allowed 12 | # s Searching Allowed (possibly computationally expensive) 13 | # S user can make bot Say things 14 | # e Extra Privs [ not implemented robustly: AVOID ] 15 | # p oP on channel by public request 16 | # ---------------------- 17 | # o Owner Flag 18 | # ---------------------- 19 | # 20 | # recommended default user flags: +trmc 21 | 22 | UserEntry default { 23 | flags +trmcs; 24 | } 25 | 26 | # here's an example entry 27 | 28 | UserEntry oznoid { 29 | name "Kevin A. Lenzo"; 30 | title "that guy"; 31 | flags +ftrmcsSope; 32 | pass rrmrxB6U4ryRk; 33 | mask *!lenzo@*.speech.cs.cmu.edu; 34 | } 35 | 36 | UserEntry plonk { 37 | name "Eep Malloy" 38 | title "that guy II"; 39 | flags +trmcspo; 40 | pass rrmrxB6U4ryRk; 41 | mask *!*@*.static.telerama.com 42 | } 43 | -------------------------------------------------------------------------------- /conf/magic8.txt: -------------------------------------------------------------------------------- 1 | original => Outlook Not So Good 2 | original => My Reply Is No 3 | original => Don't Count On It 4 | original => You May Rely On It 5 | original => Ask Again Later 6 | original => Most Likely 7 | original => Cannot Predict Now 8 | original => Yes 9 | original => Yes Definitely 10 | original => Better Not Tell You Now 11 | original => It Is Certain 12 | original => Very Doubtful 13 | original => It Is Decidedly So 14 | original => Concentrate and Ask Again 15 | original => Signs Point to Yes 16 | original => My Sources Say No 17 | original => Without a Doubt 18 | original => Reply Hazy, Try Again 19 | original => As I See It, Yes 20 | sarcastic => NOT 21 | sarcastic => What do YOU think 22 | sarcastic => Obviously 23 | sarcastic => Ask me if I care 24 | sarcastic => Yeah, and I'm the Pope 25 | sarcastic => That's ridiculous 26 | sarcastic => Who cares 27 | sarcastic => Forget about it 28 | sarcastic => You wish 29 | sarcastic => Yeah, right 30 | sarcastic => Sure 31 | sarcastic => Get a clue 32 | sarcastic => In your dreams 33 | sarcastic => Oh, please 34 | sarcastic => Whatever 35 | sarcastic => As if 36 | sarcastic => You've got to be kidding 37 | sarcastic => Dumb question. Ask another 38 | sarcastic => Not a chance 39 | userdef => Outlook Sucks 40 | userdef => THIS SPACE FOR RENT 41 | userdef => Bugger Off 42 | userdef => How appropriate, you fight like a cow 43 | userdef => Eat more cheese, then ask again 44 | userdef => When hell freezes over 45 | -------------------------------------------------------------------------------- /conf/sane-are.txt: -------------------------------------------------------------------------------- 1 | what => 2 | who => 3 | when => 4 | where => 5 | why => 6 | it => 7 | -------------------------------------------------------------------------------- /conf/sane-ignore.txt: -------------------------------------------------------------------------------- 1 | *cthulhu!hastur@*unspeakable.net # an example nick!user@host ban 2 | *!*@*nan*direct.ca 3 | *!*@200.38.211.* 4 | -------------------------------------------------------------------------------- /conf/sane-is.txt: -------------------------------------------------------------------------------- 1 | what => 2 | who => 3 | when => 4 | where => 5 | why => 6 | it => 7 | how => 8 | infobot guide => http://www.cs.cmu.edu/~infobot/infobot_guide.html 9 | -------------------------------------------------------------------------------- /doc/how_to_fix_files_uploaded_from_windows_to_unix.txt: -------------------------------------------------------------------------------- 1 | FIXING PERL AND TEXT FILES THAT HAVE BEEN UPLOADED FROM WINDOWS 2 | 3 | OK when you upload a file from Windows, it contains all 4 | these nasty control-M's on each line that screw everything 5 | up. 6 | 7 | To see them, use 8 | 9 | cat -vet 10 | 11 | where is the name of some file you want to check. 12 | You should see the control-M's. 13 | 14 | To get rid of them, use 15 | 16 | perl -pi -e 's/\cM//g' 17 | 18 | while is the file name. This does an in-place edit 19 | that removes all the control-Ms. You can do this to a bunch 20 | of files at once: 21 | 22 | perl -pi -e 's/\cM//g' 23 | 24 | or even 25 | 26 | perl -pi -e 's/\cM//g' * 27 | 28 | if all the files in the directory are text (like they ARE in 29 | the files/ directory of the infobot). 30 | 31 | perl -pi -e 's/\cM//g' files/* src/* infobot 32 | 33 | from inside the infobot directory should clean everything up. 34 | You should also clean any factpacks or factoid files or logs 35 | that you use for processing. 36 | 37 | kevin 38 | -------------------------------------------------------------------------------- /doc/intro.bit: -------------------------------------------------------------------------------- 1 |
2 | The canonical source for the infobot source and documentation is 3 | http://www.infobot.org/. 4 |
5 |

6 | The infobot connects to an Internet Relay Chat (IRC) server, 7 | joins some channels (maybe), and begins accumulating factoids. 8 | To run one, download the source, uncompress it, untar it, 9 | edit the config files, and it up. 10 |

11 | Interacting with the bot is pretty straightforward. Most of 12 | the commands and variables available to users are listed below. 13 | The bot will interact via message or on-channel. 14 |

15 | 16 |

17 |

Interacting with an infobot

18 | 19 |
    20 |
  • setting factoids: X is Y 21 |

    22 | Saying something like "X is Y" somewhere that the infobot 23 | can see it will cause the bot to store a factoid, unless 24 | X is already defined. It sets the value of X to Y. 25 |

    26 |

  • accessing factoids: What is X? 27 |

    28 | You can ask an infobot about something in a number of 29 | different ways, including "what is X?", "where is X?", 30 | or just plain "X?". 31 |

    32 |
  • altering factoids: s/A/B/ 33 |

    34 | if you just want to change a part of a factoid, use 35 | the s///operator. you have to address the bot 36 | or use a private medium to do this. 37 |

    38 | MyBot, X =~ s/A/B/ 39 |

    40 | will change the first occurence of A to B in the factoid 41 | called X. 42 |

    43 | 44 |

  • appending to existing entries: also 45 |

    46 | One can extend an existing factoid using the 47 | keyword also 48 |

    49 |

      50 | 51 | poink is also a silly word 52 | 53 |
    54 |

    55 | 56 |

  • erasing a factoid: forget 57 |

    58 | A factoid can easily be deleted by using 59 |

    60 |

    61 | 62 | infobot, forget poink 63 | 64 | 65 |

    66 | 67 |

  • changing a factoid: no, ... 68 |

    69 | You can change the entry for a factoid completely using 70 |

    71 |

      72 | 73 | no, infobot, x is wugga wugga. 74 | 75 |
    76 |

    77 | which deletes the prior entry (if possible) 78 | and replaces it with the new one. 79 |

    80 | 81 |

  • having the bot tell someone else something: tell 82 |

    83 | A user can ask an infobot to tell someone else something. 84 |

    85 |

      86 | 87 | infobot, tell fimmtiu about no web 88 | 89 |

      90 |

    91 | 92 |
  • karma / plusplus 93 |

    94 | karma for a concept may be incremented or decremeted using 95 | ++ and --. You can get the 96 | current karma 'score' for something by asking for it. 97 |

    98 |

      99 | 100 | oznoid++ 101 |

      102 | oznoid-- 103 |

      104 | karma for oznoid 105 | 106 |

      107 |

    108 | 109 |
  • status 110 |

    111 | infobots reply to status requests. 112 |

    113 |

    114 | -> [url] status

    115 | [url!infobot@ALF5.SPEECH.CS.CMU.EDU] Since Fri Mar 26 06:42:27 1999, there have been 409 116 | modifications and 2604 questions. I have been awake for 5 days, 4 hours, 24 minutes, 117 | 18 seconds this session, and currently reference 47529 factoids. 118 |

    119 | 120 |

    121 | 122 |
  • joining an allowed channel: join #infobot 123 |

    124 | On IRC, you can tell the infobot to join a channel 125 | that it's allowed to join with 126 |

    127 |

      128 | 129 | infobot, join #infobot 130 | 131 |
    132 |

    133 | If it is allowed to (in its paramter settings), it 134 | will try to join the channel. 135 |

    136 | 137 | 138 |

  • leaving a channel: part #infobot 139 |

    140 | This causes the bot to leave the given channel 141 |

    142 |

      143 | 144 | infobot, part #infobot 145 | 146 |
    147 |

    148 | leave is a synonym for part. 149 |

    150 | 151 |

  • random responses with | 152 |

    153 | You can set a list from which to pick a random response by 154 | using | 155 |

    156 |

      157 | 158 | x is a|b|c|d 159 | 160 |
    161 |

    162 | When x is asked about, the infobot will randomly choose from 163 | the |-spearated list. 164 |

    165 | 166 |

  • The <reply> factoid tag. 167 |

    168 | Normally, when the infobot replies to "What is X", it says 169 | "X is Y". This form makes it just reply "Y". 170 |

    171 |

      172 | 173 | X is <reply> Y 174 | 175 |
    176 |

    177 | 178 |

  • The <action> factoid tag (as of 0.43.5) 179 |

    180 | This causes the bot to respond as with except 181 | as an ACTION. 182 |

    183 |

      184 | 185 | X is <action> Y 186 | 187 |
    188 |

    189 | 190 |

  • backwacking 191 |

    192 | Use \ to protect items from evaluation. 193 |

    194 |

      195 | 196 | x is y is y 197 | 198 |
    199 |

    200 | will normally set x =is=> y is y, but 201 |

    202 |

      203 | 204 | x \is y is y 205 | 206 |
    207 |

    208 | will set 209 |

    210 |

      211 | x is y =is=> y 212 |
    213 |

    214 | The forget 215 | and no (update) operators apply before checking 216 | for this. This is also useful for getting around the 217 | dereferencing of "i" and "me" and so on. 218 |

    219 | 220 |

  • the $who variable 221 |

    222 | Contains the nickname person currently addressing the bot. 223 | It can be used effectively in replies. 224 |

    225 |

      226 | 227 | nice day is <reply> you betcha, $who. 228 | 229 |
    230 |

    231 | 232 |

  • the $date variable 233 |

    234 | Contains the current date and time, at the bot's host. 235 |

    236 | 237 |

  • literal foo 238 |

    239 | returns the value without the usual post-processing. 240 |

    241 |

    242 | 243 |

  • Ignoring users: ignore nickname, ignore *.a.com 244 |

    245 | Users with the P (oP) flag can tell the bot 246 | to ignore people or hostmasks. And 'unignore'. 247 | use 'ignorelist' to get the current list of ignored masks, 248 | if you have the P flag. 249 |

    250 |
  • op on channel 251 |

    252 | The 'p' (oP) flag in the userfile allows this 253 | to work. You'll need to set a hostmask. See 254 | files/infobot.users Also uses a 255 | crypted password. 256 |

    257 |

    258 | 259 | /msg <bot> <password> op 260 | 261 | 262 |

    263 |

  • die 264 |

    265 | If the bot owner (+O, Owner) says this or messages it to the bot, 266 | it will kill itself. 267 |

    268 |

269 | 270 |
271 |

scripts/utilities

272 | 273 | The infobot comes with some scripts for working with 274 | the DBM files. 275 |

276 | 277 |

    278 |
  • update_db 279 |

    280 | This takes a flat ascii file and inserts it into a DBM file. 281 | It creates a new DBM if it didn't exist. 282 |

    283 |

      284 | 285 | scripts/update_db factpacks/code_to_country.txt infobot-is 286 | 287 |
    288 |

    289 | will add the factoids in code_to_country.txt 290 | to the infobot-is DBM. 291 |

    292 |

  • dump_db 293 |

    294 | The converse. It dumps out the DBM file to a flat 295 | ascii file. Note there is no extension on the DBM name, 296 | even though the system may use one. 297 |

    298 |

      299 | 300 | scripts/dump_db infobot-is 301 | 302 |
    303 |

    304 | Note there is no extension on the DBM name, even though the 305 | system may use one (like .pag and 306 | .dir or .db). 307 |

    308 | 309 |

310 | 311 |
312 | 313 | -------------------------------------------------------------------------------- /doc/makemanual.pl: -------------------------------------------------------------------------------- 1 | # First stab at automagically generating the manual from the config 2 | # files and module documentation. 3 | # Simon Cozens, 1999- 4 | 5 | # DON'T, I'M NOT FINISHED YET! 6 | 7 | use Pod::Html; 8 | use strict; 9 | use vars qw($version $VER_MAJ $VER_MIN $VER_MOD); 10 | sub status (@) {print "@_\n"} 11 | 12 | require "../src/Params.pl"; 13 | require "../src/IrcExtras.pl"; 14 | 15 | # Things we know to be core modules: 16 | my %source = map {$_, 1} qw{ 17 | ANSI.pl IrcHooks.pl Reply.pl CTCP.pl 18 | Search.pl Channel.pl Math.pl Setup.pl 19 | DBM.pl Misc.pl Speller.pl Extras.pl 20 | Norm.pl Statement.pl module-template Help.pl 21 | Params.pl myRoutines.pl Process.pl Update.pl 22 | Irc.pl Question.pl User.pl IrcExtras.pl 23 | }; 24 | 25 | 26 | status "Generating manual for $version"; 27 | loadParamFiles($ARGV[0]||"../files/infobot.config"); 28 | 29 | open(OUT,">infobot-guide.html") 30 | or die "! Couldn't write on infobot-guide.html: $!\n"; 31 | 32 | status "Writing the header..."; 33 | print OUT < 36 | 37 | 38 | 39 | Infobot Guide $VER_MAJ\.$VER_MIN\.$VER_MOD 40 | 41 | 42 | 43 |

Infobot Guide $VER_MAJ\.$VER_MIN\.$VER_MOD

44 | 45 | EOF 46 | 47 | status "Writing the introduction and main commands summary..."; 48 | open(BIT1, "intro.bit") 49 | or die "! Can't load the introduction to the guide: $!\n"; 50 | { local $/=undef; print OUT ;} 51 | 52 | print "Scanning for extension modules..."; 53 | opendir(DH, "../src/") or die "! Couldn't open source directory: $!\n"; 54 | my @mods=(); 55 | $|=1; 56 | while (defined ($_=readdir(DH))) { 57 | next unless -f "../src/$_"; 58 | next if exists $source{$_}; 59 | print "."; 60 | read_it($_); 61 | } 62 | 63 | status "\nWriting the rest of the document..."; 64 | open(BIT1, "outro.bit") 65 | or die "! Can't load the end of the guide: $!\n"; 66 | { local $/=undef; print OUT ;} 67 | 68 | status "Manual created succesfully."; 69 | 70 | sub read_it { 71 | my $file=shift; 72 | open (FH, "../src/$file") or die "! Couldn't open $file: $!\n"; 73 | my $found=0; 74 | my @pods; 75 | local $/=""; 76 | while () { 77 | $found =1 if (/^=head1/); 78 | push @pods, $_ if $found; 79 | } 80 | unless ($found) { 81 | warn "\nNo documentation for $file; bad author!\n" unless $found; 82 | return; 83 | } 84 | close FH; 85 | # Process pods into HTML 86 | } 87 | -------------------------------------------------------------------------------- /extras/ANSI.pl: -------------------------------------------------------------------------------- 1 | require 5.001; 2 | 3 | %attributes = ('clear' => 0, 4 | 'reset' => 0, 5 | 'bold' => 1, 6 | 'underline' => 4, 7 | 'underscore' => 4, 8 | 'blink' => 5, 9 | 'reverse' => 7, 10 | 'concealed' => 8, 11 | 'black' => 30, 'on_black' => 40, 12 | 'red' => 31, 'on_red' => 41, 13 | 'green' => 32, 'on_green' => 42, 14 | 'yellow' => 33, 'on_yellow' => 43, 15 | 'blue' => 34, 'on_blue' => 44, 16 | 'magenta' => 35, 'on_magenta' => 45, 17 | 'cyan' => 36, 'on_cyan' => 46, 18 | 'white' => 37, 'on_white' => 47); 19 | 20 | $b_black = cl('bold black'); $_black = cl('black'); 21 | $b_red = cl('bold red'); $_red = cl('red'); 22 | $b_green = cl('bold green'); $_green = cl('green'); 23 | $b_yellow = cl('bold yellow'); $_yellow = cl('yellow'); 24 | $b_blue = cl('bold blue'); $_blue = cl('blue'); 25 | $b_magenta = cl('bold magenta'); $_magenta = cl('magenta'); 26 | $b_cyan = cl('bold cyan'); $_cyan = cl('cyan'); 27 | $b_white = cl('bold white'); $_white = cl('white'); 28 | $_reset = cl('reset'); $_bold = cl('bold'); 29 | $ob = cl('reset'); $b = cl('bold'); 30 | 31 | ############################################################################ 32 | # Implementation (attribute string form) 33 | ############################################################################ 34 | 35 | # Return the escape code for a given set of color attributes. 36 | sub cl { 37 | my @codes = map { split } @_; 38 | my $attribute = ''; 39 | foreach (@codes) { 40 | $_ = lc $_; 41 | unless (defined $attributes{$_}) { die "Invalid attribute name $_" } 42 | $attribute .= $attributes{$_} . ';'; 43 | } 44 | chop $attribute; 45 | ($attribute ne '') ? "\e[${attribute}m" : undef; 46 | } 47 | 48 | # Given a string and a set of attributes, returns the string surrounded by 49 | # escape codes to set those attributes and then clear them at the end of the 50 | # string. If $EACHLINE is set, insert a reset before each occurrence of the 51 | # string $EACHLINE and the starting attribute code after the string 52 | # $EACHLINE, so that no attribute crosses line delimiters (this is often 53 | # desirable if the output is to be piped to a pager or some other program). 54 | sub c { 55 | my $string = shift; 56 | if (defined $EACHLINE) { 57 | my $attr = cl (@_); 58 | join $EACHLINE, 59 | map { $_ ne "" ? $attr . $_ . "\e[0m" : "" } 60 | split ($EACHLINE, $string); 61 | } else { 62 | cl (@_) . $string . "\e[0m"; 63 | } 64 | } 65 | 66 | 1; 67 | -------------------------------------------------------------------------------- /extras/Aviation.pl: -------------------------------------------------------------------------------- 1 | # 2 | # aviation -- infobot module for various flight-planning bits. 3 | # Was originally 'metar' until infobot 44.5. 4 | # 5 | # 1999/07/?? Rich Lafferty 6 | # - Initial version 7 | # 1999/08/02 lenzo@cs.cmu.edu 8 | # - package, BEGIN, eval checks 9 | # 1999/09/16 lenzo@cs.cmu.edu 10 | # - added a timeout 11 | # 2000/??/?? Lazarus Long 12 | # - modified to weather.noaa.gov to reflect hostname change 13 | # 2000/11/09 rich@alcor.concordia.ca 14 | # - NAME CHANGE: now 'aviation' to reflect new functions 15 | # - partial rewrite of metar code: now that we have 'weather', we 16 | # don't need to massage the data for grounded people. 17 | # - status() added to whine about missing modules 18 | # - added more aviation functions (taf, great-circle, zulutime) 19 | # 2000/11/17 rich@alcor.concordia.ca 20 | # - rewrite each function into separate sub 21 | # - fork to handle all requests (even though only web-based requests 22 | # really need to fork. 23 | # 2000/11/18 rich@alcor.concordia.ca 24 | # - added airport name/code lookups, fixed minor bugs in other parts 25 | 26 | package Aviation; 27 | 28 | my ($no_aviation, $no_entities); 29 | 30 | BEGIN { 31 | eval "use LWP::UserAgent"; 32 | if ($@) { $no_aviation++}; 33 | eval "use HTML::Entities"; 34 | if ($@) { $no_entities++}; 35 | } 36 | 37 | # Set the following to 1 if you want the forecast separators in 38 | # a TAF (PROB, BECMG, FM, TEMPO) to be bold. For those that don't know 39 | # from aviation forecasts, each of the above keywords signifies a new 40 | # section of the TAF -- the equivalent, for example, of the "from 10 to 2" 41 | # in "Sunny tomorrow; from 10 to 2, chance of showers". 42 | my $taf_highlight_bold = 1; 43 | 44 | # 45 | # Figure out what we're supposed to do, and do it 46 | # 47 | sub Aviation::get { 48 | if ($no_aviation) { 49 | &main::status("Aviation module requires LWP::UserAgent."); 50 | return ''; 51 | } 52 | 53 | my ($line, $callback) = @_; 54 | $SIG{CHLD} = 'IGNORE'; 55 | my $pid = eval { fork() }; # catch non-forking OSes and other errors 56 | return 'NOREPLY' if $pid; # parent does nothing 57 | if ($line =~ /^metar/i) { $callback->(metar($line)) } 58 | elsif ($line =~ /^taf/i) { $callback->(taf($line)) } 59 | elsif ($line =~ /^great[-\s]?circle/i) { $callback->(greatcircle($line)) } 60 | elsif ($line =~ /^tsd/i) { $callback->(tsd($line)) } 61 | elsif ($line =~ /^zulutime/i) { $callback->(zulutime($line)) } 62 | elsif ($line =~ /^airport/i) { $callback->(airport($line)) } 63 | elsif ($line =~ /^aviation/i) { $callback->(aviation($line)) } 64 | else { $callback->("I think we just lost a wing!") } # reach here -> Extras.pl problem 65 | exit 0 if defined $pid; # child exits, non-forking OS returns 66 | 67 | } 68 | 69 | # 70 | # aviation - list available aviation functions 71 | # 72 | sub aviation { 73 | return "My aviation-related functions are metar, taf, great-circle, tsd, zulutime, and airport. For help with any, ask me about ' help'."; 74 | } 75 | 76 | # 77 | # METAR - current weather observation 78 | # 79 | sub metar { 80 | my $line = shift; 81 | if ($line =~ /^metar\s+(for\s+)?(.*)/i) { 82 | 83 | # ICAO airport codes *can* contain numbers, despite earlier claims. 84 | # Americans tend to use old FAA three-letter codes; luckily we can 85 | # *usually* guess what they mean by prepending a 'K'. The author, 86 | # being Canadian, is similarly lazy. 87 | my $site_id = uc($2); 88 | $site_id =~ s/[.?!]$//; 89 | $site_id =~ s/\s+$//g; 90 | return "'$site_id' doesn't look like a valid ICAO airport identifier." 91 | unless $site_id =~ /^[\w\d]{3,4}$/; 92 | $site_id = "C" . $site_id if length($site_id) == 3 && $site_id =~ /^Y/; 93 | $site_id = "K" . $site_id if length($site_id) == 3; 94 | 95 | # HELP isn't an airport, so we use it for a reference work. 96 | return "For observations, ask me 'metar '. For information on decoding Aerodrome Weather Observations (METAR), see http://www.avweb.com/toc/metartaf.html" 97 | if $site_id eq 'HELP'; 98 | 99 | my $metar_url = "http://weather.noaa.gov/cgi-bin/mgetmetar.pl?cccc=$site_id"; 100 | 101 | # Grab METAR report from Web. 102 | my $agent = new LWP::UserAgent; 103 | if (my $proxy = main::getparam('httpproxy')) { $agent->proxy('http', $proxy) }; 104 | $agent->timeout(10); 105 | my $grab = new HTTP::Request GET => $metar_url; 106 | 107 | my $reply = $agent->request($grab); 108 | 109 | # If it can't find it, assume luser error :-) 110 | return "Either $site_id doesn't exist (try a 4-letter station code like KAGC), or the site NOAA site is unavailable right now." 111 | unless $reply->is_success; 112 | 113 | # extract METAR from incredibly and painfully verbose webpage 114 | my $webdata = $reply->as_string; 115 | $webdata =~ m/($site_id\s\d+Z.*?)'. For information on decoding Terminal Area Forecasts, see http://www.avweb.com/toc/metartaf.html" 152 | if $site_id eq 'HELP'; 153 | 154 | my $taf_url = "http://weather.noaa.gov/cgi-bin/mgettaf.pl?cccc=$site_id"; 155 | 156 | # Grab METAR report from Web. 157 | my $agent = new LWP::UserAgent; 158 | if (my $proxy = main::getparam('httpproxy')) { $agent->proxy('http', $proxy) }; 159 | $agent->timeout(10); 160 | my $grab = new HTTP::Request GET => $taf_url; 161 | 162 | my $reply = $agent->request($grab); 163 | 164 | # If it can't find it, assume luser error :-) 165 | return "I can't seem to retrieve data from weather.noaa.com right now." 166 | unless $reply->is_success; 167 | 168 | # extract TAF from equally verbose webpage 169 | my $webdata = $reply->as_string; 170 | $webdata =~ m/($site_id( AMD)* \d+Z .*?)proxy('http', $proxy) }; 222 | $agent->timeout(10); 223 | my $grab = new HTTP::Request GET => $gc_url; 224 | 225 | my $reply = $agent->request($grab); 226 | 227 | # If it can't find it, assume luser error :-) 228 | unless ($reply->is_success) { 229 | return "I can't seem to retrieve data from www.landings.com right now."; 230 | } 231 | 232 | # extract TAF from equally verbose webpage 233 | my $webdata = $reply->as_string; 234 | my $gcd; 235 | if ($webdata =~ m/circle: ([.\d]+).*?, ([.\d]+).*?, ([.\d]+).*?heading: ([.\d]+)/s) { 236 | $gcd = "Great-circle distance: $1 mi, $2 nm, $3 km, heading $4 degrees true"; 237 | } 238 | else { 239 | $webdata =~ m/(No airport.*?database)/; 240 | $gcd = $1; 241 | } 242 | 243 | return $gcd; 244 | } 245 | else { 246 | # malformed 247 | return "That doesn't look right. The 'great-circle' command takes two airport identifiers and returns the great circle distance and heading between them."; 248 | } 249 | } 250 | 251 | # 252 | # tsd -- calculate time, speed, distance, given any two 253 | # 254 | sub tsd { 255 | my $line = shift; 256 | return "To solve time/speed/distance problems, substitute 'x' for " . 257 | "the unknown value in 'tsd TIME SPEED DISTANCE'. For example, " . 258 | "'tsd 3 x 200' will solve for the speed in at which you can travel " . 259 | "200 mi in 3h." if $line =~ /help/i; 260 | 261 | my ($time, $speed, $distance) = ($line =~ /^tsd\s+(\S+)\s+(\S+)\s+(\S+)$/); 262 | 263 | my $error; 264 | $error++ unless $time && $speed && $distance; 265 | 266 | if ($time =~ /^[A-Za-z]$/) { # solve for time 267 | $error++ unless $speed =~ /^[\d.]+$/; 268 | $error++ unless $distance =~ /^[\d.]+$/; 269 | return $distance / $speed unless $error; 270 | } 271 | elsif ($speed =~ /^[A-Za-z]$/) { # solve for speed 272 | $error++ unless $time =~ /^[\d.]+$/; 273 | $error++ unless $distance =~ /^[\d.]+$/; 274 | return $distance / $time unless $error; 275 | } 276 | elsif ($distance =~ /^[A-Za-z]$/) { # solve for distance 277 | $error++ unless $speed =~ /^[\d.]+$/; 278 | $error++ unless $time =~ /^[\d.]+$/; 279 | return $time * $speed unless $error; 280 | } 281 | 282 | return "Your time/speed/distance problem looks incorrect. For help, try 'tsd help'."; 283 | 284 | } 285 | 286 | 287 | # 288 | # zulutime -- return current UTC time 289 | # 290 | sub zulutime { 291 | $line = shift; 292 | return "zulutime returns the time in DDHHMM format." if $line =~ /help/i; 293 | return sprintf('%02d%02d%02dZ', reverse((gmtime())[1..3])); 294 | } 295 | 296 | # 297 | # airport -- look up airport by identifier (airport name for ___) or by 298 | # name (airport code(s) for ___). To avoid confusion, we 299 | # explicitly discard FAA-but-not-ICAO identifiers. 300 | # 301 | sub airport { 302 | 303 | my $line = shift; 304 | if ($line =~ /^airport\s+(name|code|id)s?\s+(for\s+)?(.*)/i) { 305 | my $function = lc($1); 306 | my $query = $3; 307 | 308 | if ($function eq 'name') { 309 | $query = "C" . $query if length($query) == 3 && $query =~ /^Y/; 310 | $query = "K" . $query if length($query) == 3; 311 | $query = uc($query); 312 | $query =~ s/[.?!]$//; 313 | $query =~ s/\s+$//; 314 | 315 | return "That doesn't look like a valid ICAO airport identifier. (Perhaps you mean 'airport code for $query'?)" 316 | unless length($query) == 4; 317 | 318 | my $apt_url = "http://www6.landings.com/cgi-bin/nph-search_apt?1=$query&max_ret=1"; 319 | 320 | # Grab airport data from Web. 321 | 322 | my $agent = new LWP::UserAgent; 323 | if (my $proxy = main::getparam('httpproxy')) { $agent->proxy('http', $proxy) }; 324 | $agent->timeout(10); 325 | my $grab = new HTTP::Request GET => $apt_url; 326 | 327 | my $reply = $agent->request($grab); 328 | 329 | # If it can't find it, assume luser error :-) 330 | return "I can't seem to access my airport data -- perhaps try again later." 331 | unless $reply->is_success; 332 | 333 | # extract csv-format airport data from incredibly and painfully verbose webpage 334 | my $webdata = $reply->as_string; 335 | @apt_lines = split (/\n/, $webdata); 336 | 337 | my $print_next = 0; 338 | my $response = ''; 339 | 340 | foreach (@apt_lines) { 341 | # skip over entries without ICAO idents (ICAO: n/a) 342 | if (/\(ICAO: [^n]/) { $response .= "$_, "; $pnext = 1; } 343 | elsif ($pnext) { $response .= $_; $pnext = 0; } 344 | } 345 | 346 | $response =~ s/(<.*?>)+/ /g; # naive, but works in *this* case. 347 | $response =~ s/.*?\) //; # strip (ICAO: foo) bit 348 | $response =~ s/\s+/ /g; 349 | $response =~ s/ ,/,/g; # pet peeve. 350 | 351 | if ($no_entities and $response =~ /(&.*?;)/) { 352 | &main::status("Aviation module 'airport' function just output a raw HTML entity ($1) because you don't have HTML::Entities installed."); 353 | $response .= "\n(Excuse the HTML entity. I don't have HTML::Entities handy.)"; 354 | } 355 | else { 356 | $response = decode_entities($response); 357 | } 358 | 359 | if ($response) { 360 | return "$query is $response"; 361 | } 362 | else { 363 | return "I can't find an airport for $query."; 364 | } 365 | 366 | } 367 | elsif ($function eq 'code' or $function eq 'id') { 368 | $query =~ s/[.?!]$//; 369 | $query =~ s/\s+$//; 370 | my $apt_url = "http://www6.landings.com/cgi-bin/nph-search_apt?5=$query&max_ret=100"; 371 | 372 | # Grab airport data from Web. 373 | 374 | my $agent = new LWP::UserAgent; 375 | if (my $proxy = main::getparam('httpproxy')) { $agent->proxy('http', $proxy) }; 376 | $agent->timeout(10); 377 | my $grab = new HTTP::Request GET => $apt_url; 378 | 379 | my $reply = $agent->request($grab); 380 | 381 | # If it can't find it, assume luser error :-) 382 | return "I can't seem to access my airport data -- perhaps try again later." 383 | unless $reply->is_success; 384 | 385 | # extract csv-format airport data from incredibly and painfully verbose webpage 386 | my $webdata = $reply->as_string; 387 | @apt_lines = split (/\n/, $webdata); 388 | 389 | my $response = ''; 390 | 391 | foreach (@apt_lines) { 392 | $response .= "$1 " if m|\(ICAO: ([^n]+?)|; 393 | } 394 | 395 | $response =~ s/(<.*?>)+/ /g; # naive, but works in *this* case. 396 | 397 | if ($response) { 398 | return "$query may be: $response"; 399 | } 400 | else { 401 | return "I can't find an airport code for $query."; 402 | } 403 | 404 | } 405 | # else fall through to malformed bit below 406 | } 407 | 408 | # malformed 409 | return "That doesn't look right. Try 'airport code for CITY' or 'airport name for CODE' instead."; 410 | } 411 | 412 | 413 | 1; 414 | __END__ 415 | -------------------------------------------------------------------------------- /extras/DNS.pl: -------------------------------------------------------------------------------- 1 | 2 | # infobot :: Kevin Lenzo (c) 1997 3 | 4 | # once again, thanks to Patrick Cole 5 | 6 | #use POSIX; 7 | use Socket; 8 | 9 | sub REAPER { 10 | $SIG{CHLD} = \&REAPER; # loathe sysV 11 | $waitedpid = wait; 12 | } 13 | 14 | $SIG{CHLD} = \&REAPER; 15 | $DNS_CACHE_EXPIRE_TIME = 7*24*60*60; 16 | 17 | sub DNS { 18 | my $in = $_[0]; 19 | my($match, $x, $y, $result); 20 | 21 | if (($DNS_CACHE{$in}) && ((time()-$DNS_TIME_CACHE{$in}) < $DNS_CACHE_EXPIRE_TIME)) { 22 | return $DNS_CACHE{$in}; 23 | } 24 | 25 | if (!defined($pid = fork)) { 26 | return "no luck, $safeWho"; 27 | } elsif ($pid) { 28 | # parent 29 | } else { 30 | # child 31 | if ($in =~ /(\d+\.\d+\.\d+\.\d+)/) { 32 | &status("DNS query by IP address: $in"); 33 | $match = $1; 34 | $y = pack('C4', split(/\./, $match)); 35 | $x = (gethostbyaddr($y, &AF_INET)); 36 | if ($x !~ /^\s*$/) { 37 | $result = $match." is ".$x unless ($x =~ /^\s*$/); 38 | } else { 39 | $result = "I can't seem to find that address in DNS"; 40 | } 41 | } else { 42 | &status("DNS query by name: $in"); 43 | $x = join('.',unpack('C4',(gethostbyname($in))[4])); 44 | if ($x !~ /^\s*$/) { 45 | $result = $in." is ".$x; 46 | } else { 47 | $result = "I can\'t find that machine name"; 48 | } 49 | } 50 | $DNS_TIME_CACHE{$in} = time(); 51 | $DNS_CACHE{$in} = $result; 52 | 53 | if ($msgType eq 'public') { 54 | &say($result); 55 | } else { 56 | &msg($who, $result); 57 | } 58 | exit; # bye child 59 | } 60 | } 61 | 62 | 1; 63 | 64 | __END__ 65 | 66 | =head1 NAME 67 | 68 | DNS.pl - Look up hosts in DNS 69 | 70 | =head1 PREREQUISITES 71 | 72 | None. 73 | 74 | =head1 PARAMETERS 75 | 76 | allowDNS 77 | 78 | =head1 PUBLIC INTERFACE 79 | 80 | nslookup|DNS [for] 81 | 82 | =head1 DESCRIPTION 83 | 84 | Looks up DNS entries for the given host using 85 | C/C calls. 86 | 87 | =head1 AUTHORS 88 | 89 | Kevin Lenzo 90 | -------------------------------------------------------------------------------- /extras/Internic.pl: -------------------------------------------------------------------------------- 1 | # infobot :: Kevin Lenzo (c) 1997 2 | 3 | use Socket; 4 | use POSIX; 5 | 6 | sub I_REAPER { 7 | $SIG{CHLD} = \&I_REAPER; 8 | $waitedpid = wait; 9 | } 10 | 11 | $SIG{CHLD} = \&I_REAPER; 12 | $DOMAIN_CACHE_EXPIRE_TIME = 7*24*60*60; 13 | 14 | sub domain_summary { 15 | # summarize the goo from internic 16 | 17 | my $item = $_[0]; 18 | my @result; 19 | my $result; 20 | my @dom; 21 | 22 | if (($DOMAIN_CACHE{$item}) 23 | && ((time()-$DOMAIN_TIME_CACHE{$item}) < $DOMAIN_CACHE_EXPIRE_TIME)) { 24 | return $DOMAIN_CACHE{$item}; 25 | } 26 | 27 | if (!defined($pid = fork)) { 28 | return "no luck, $safeWho"; 29 | } elsif ($pid) { 30 | # parent 31 | } else { 32 | # child 33 | @dom = &domain_lookup($item); 34 | if ($dom[0] !~ /No match/) { 35 | foreach (@dom) { 36 | print ; 37 | next if /^\s*$/; 38 | s/:/: /; 39 | s/\s+/ /g; 40 | next if /^\s*Record/; 41 | next if /^\s*Domain Name/; 42 | # next if /^\s*\S+ Contact/; 43 | # last if /^\s*Domain servers/; 44 | last if /^To single out/; 45 | if (s/the internic.*//i) { 46 | push @result, $_; 47 | last; 48 | } 49 | s/Administrative Contact/Admin/; 50 | s/Technical Contact/Tech/; 51 | s/Domain servers in listed order/DNS/; 52 | push @result, $_; 53 | last if ($#result > 15); 54 | } 55 | foreach (@result) { s/\s+/ /; s/^\s+//; } 56 | foreach (0..$#result-1) { 57 | $result[$_].="; " unless $result[$_]=~/:\s*$/; 58 | } 59 | $result = join("", @result); 60 | $result =~ s/\s+;/;/g; 61 | $result =~ s/\s+/ /g; 62 | } else { 63 | $result = "I can't find the domain $item"; 64 | } 65 | $DOMAIN_TIME_CACHE{$item} = time(); 66 | $DOMAIN_CACHE{$item} = $result; 67 | &msg($who, $result); 68 | 69 | exit; # exit child. 70 | } 71 | } 72 | 73 | sub domain_lookup { 74 | # do the actual looking up 75 | my($lookup) = @_; 76 | my ($name, $aliases, $proto, $port, $len, 77 | $this, $that, $thisaddr, $thataddr, $hostname); 78 | 79 | my @result; 80 | 81 | my $whois_server = 'rs.internic.net'; 82 | my $whois_port = 43; 83 | 84 | $sockaddr = 'S n a4 x8'; 85 | chop($hostname = `hostname`); 86 | 87 | ($name, $aliases, $proto) = getprotobyname('tcp'); 88 | ($name, $aliases, $whois_port) = getservbyname($whois_port, 'tcp') 89 | unless $whois_port =~ /^\d+$/; 90 | ($name, $aliases, $type, $len, $thisaddr) = gethostbyname($hostname); 91 | ($name, $aliases, $type, $len, $thataddr) = gethostbyname($whois_server); 92 | 93 | $this = pack($sockaddr, AF_INET, 0, $thisaddr); 94 | $that = pack($sockaddr, AF_INET, $whois_port, $thataddr); 95 | 96 | socket(DOMAIN_SERVER, PF_INET, SOCK_STREAM, $proto) 97 | || die "socket: $!"; 98 | bind(DOMAIN_SERVER, $this) || die "bind: $!"; 99 | connect(DOMAIN_SERVER, $that) || die "connect: $!"; 100 | 101 | select(DOMAIN_SERVER); $| = 1; 102 | 103 | print DOMAIN_SERVER $lookup."\r\n"; 104 | 105 | @result = (); 106 | my $line; 107 | while (($#result < 30) && ($line = )) { 108 | next if (1.. $line =~ /Registrant:/); 109 | push(@result,$line); 110 | } 111 | close(DOMAIN_SERVER); select(STDOUT); 112 | 113 | unshift @result, "Registrant: " if @result; 114 | @result; 115 | } 116 | 117 | 1; 118 | 119 | __END__ 120 | 121 | =head1 NAME 122 | 123 | Internic.pl - look up Internic/RIPE whois records for a host 124 | 125 | =head1 PREREQUISITES 126 | 127 | Just the standard stuff. 128 | 129 | =head1 PARAMETERS 130 | 131 | allowInternic 132 | 133 | =head1 PUBLIC INTERFACE 134 | 135 | Internic|RIPE for 136 | 137 | =head1 DESCRIPTION 138 | 139 | Queries RIPE or the Internic for the whois information about the 140 | supplied host, and formats it up nicely. 141 | 142 | =head1 AUTHORS 143 | 144 | Kevin Lenzo 145 | -------------------------------------------------------------------------------- /extras/Math.pl: -------------------------------------------------------------------------------- 1 | 2 | # infobot copyright (C) kevin lenzo 1997-98 3 | 4 | if (!%digits) { 5 | %digits = ( 6 | "first", "1", 7 | "second", "2", 8 | "third", "3", 9 | "fourth", "4", 10 | "fifth", "5", 11 | "sixth", "6", 12 | "seventh", "7", 13 | "eighth", "8", 14 | "ninth", "9", 15 | "tenth", "10", 16 | "one", "1", 17 | "two", "2", 18 | "three", "3", 19 | "four", "4", 20 | "five", "5", 21 | "six", "6", 22 | "seven", "7", 23 | "eight", "8", 24 | "nine", "9", 25 | "ten", "10" 26 | ); 27 | } 28 | 29 | sub math { 30 | my $in = $_[0]; 31 | # Math handling. 32 | 33 | foreach $x (keys %digits) { 34 | $in =~ s/\b$x\b/$digits{$x}/g; 35 | } 36 | 37 | if (getparam('fortranMath')) { 38 | if ($in =~ /^calc\s+(.+)$/) { 39 | $parm = $1; 40 | $parm =~ s/\s//g; 41 | #$parm =~ s/[a-zA-Z]//g; 42 | status("bc: $parm"); 43 | open(P, "echo '$parm'|bc 2>&1 |"); # dgl++ 44 | $tmp = ''; 45 | @prevs = (); 46 | foreach $line (

) { 47 | chomp $line; 48 | $line =~ s/\\$//; 49 | $line =~ s/\(standard_in\) 1: /$who: /; 50 | $tmp = 0; 51 | foreach $p (@prevs) { 52 | if ($p eq $line) { 53 | $tmp = 1; 54 | } 55 | } 56 | if ($tmp == 0 && $line !~ /illegal character/) { 57 | performReply($line); 58 | } 59 | push(@prevs, $line); 60 | } 61 | close(P); 62 | return undef; 63 | } 64 | } 65 | 66 | if (getparam('perlMath')) { 67 | if (($in !~ /^\s*$/) and ($in !~ /(\d+\.){2,}/)) { 68 | my($locMsg) = $in; 69 | 70 | foreach (keys %digits) { 71 | $locMsg =~ s/$_/$digits{$_}/g; 72 | } 73 | 74 | while ($locMsg =~ /(exp ([\w\d]+))/) { 75 | $exp = $1; 76 | $val = exp($2); 77 | $locMsg =~ s/$exp/+$val/g; 78 | } 79 | while ($locMsg =~ /(hex2dec\s*([0-9A-Fa-f]+))/) { 80 | $exp = $1; 81 | $val = hex($2); 82 | $locMsg =~ s/$exp/+$val/g; 83 | } 84 | if ($locMsg =~ /^\s*(dec2hex\s*(\d+))\s*\?*/) { 85 | $exp = $1; 86 | $val = sprintf("%x", "$2"); 87 | $locMsg =~ s/$exp/+$val/g; 88 | } 89 | $e = exp(1); 90 | $locMsg =~ s/\be\b/$e/; 91 | 92 | while ($locMsg =~ /(log\s*((\d+\.?\d*)|\d*\.?\d+))\s*/) { 93 | $exp = $1; 94 | $res = $2; 95 | if ($res == 0) { $val = "Infinity";} 96 | else { $val = log($res); } ; 97 | $locMsg =~ s/$exp/+$val/g; 98 | } 99 | 100 | while ($locMsg =~ /(bin2dec ([01]+))/) { 101 | $exp = $1; 102 | $val = join ('', unpack ("B*", $2)) ; 103 | $locMsg =~ s/$exp/+$val/g; 104 | } 105 | 106 | while ($locMsg =~ /(dec2bin (\d+))/) { 107 | $exp = $1; 108 | $val = join('', unpack('B*', pack('N', $2))); 109 | $val =~ s/^0+//; 110 | $locMsg =~ s/$exp/+$val/g; 111 | } 112 | 113 | $locMsg =~ s/ to the / ** /g; 114 | $locMsg =~ s/\btimes\b/\*/g; 115 | $locMsg =~ s/\bdiv(ided by)? /\/ /g; 116 | $locMsg =~ s/\bover /\/ /g; 117 | $locMsg =~ s/\bsquared/\*\*2 /g; 118 | $locMsg =~ s/\bcubed/\*\*3 /g; 119 | $locMsg =~ s/\bto\s+(\d+)(r?st|nd|rd|th)?( power)?/\*\*$1 /ig; 120 | $locMsg =~ s/\bpercent of/*0.01*/ig; 121 | $locMsg =~ s/\bpercent/*0.01/ig; 122 | $locMsg =~ s/\% of\b/*0.01*/g; 123 | $locMsg =~ s/\%/*0.01/g; 124 | $locMsg =~ s/\bsquare root of (\d+)/$1 ** 0.5 /ig; 125 | $locMsg =~ s/\bcubed? root of (\d+)/$1 **(1.0\/3.0) /ig; 126 | $locMsg =~ s/ of / * /; 127 | $locMsg =~ s/(bit(-| )?)?xor(\'?e?d( with))?/\^/g; 128 | $locMsg =~ s/(bit(-| )?)?or(\'?e?d( with))?/\|/g; 129 | $locMsg =~ s/bit(-| )?and(\'?e?d( with))?/\& /g; 130 | $locMsg =~ s/(plus|and)/+/ig; 131 | 132 | if (($locMsg =~ /^\s*[-\d*+\s()\/^\.\|\&\*\!]+\s*$/) 133 | && ($locMsg !~ /^\s*\(?\d+\.?\d*\)?\s*$/) 134 | && ($locMsg !~ /^\s*$/) 135 | && ($locMsg !~ /^\s*[( )]+\s*$/)) 136 | { 137 | # $tmpMsg = $locMsg; 138 | 139 | $locMsg = eval($locMsg); 140 | 141 | if ($locMsg =~ /^[-+\de\.]+$/) { 142 | # $locMsg = sprintf("%1.12f", $locMsg); 143 | $locMsg =~ s/\.0+$//; 144 | $locMsg =~ s/(\.\d+)000\d+/$1/; 145 | if (length($locMsg) > 30) { 146 | $locMsg = "a number with quite a few digits..."; 147 | } 148 | 149 | return $locMsg; 150 | } else { 151 | $locMsg = undef; 152 | } 153 | } 154 | } 155 | } 156 | 157 | 158 | return undef; 159 | } 160 | 161 | 1; 162 | -------------------------------------------------------------------------------- /extras/NOAA.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | package Weather; 4 | 5 | # kevin lenzo (C) 1999 -- get the weather forcast NOAA. 6 | # feel free to use, copy, cut up, and modify, but if 7 | # you do something cool with it, let me know. 8 | 9 | # 16-SEP-99 lenzo@cs.cmu.edu switched to LWP::UA and 10 | # put in a timeout. 11 | 12 | my $no_weather; 13 | my $cache_time = 60 * 40 ; # 40 minute cache time 14 | my $default = 'KAGC'; 15 | 16 | BEGIN { 17 | $no_weather = 0; 18 | eval "use LWP::UserAgent"; 19 | $no_weather++ if ($@); 20 | } 21 | 22 | sub Weather::NOAA::get { 23 | my ($station) = shift; 24 | $station = uc($station); 25 | my $result; 26 | 27 | if ($no_weather) { 28 | return 0; 29 | } else { 30 | 31 | if (exists $cache{$station}) { 32 | my ($time, $response) = split $; , $cache{$station}; 33 | if ((time() - $time) < $cache_time) { 34 | return $response; 35 | } 36 | } 37 | 38 | my $ua = new LWP::UserAgent; 39 | if (my $proxy = main::getparam('httpproxy')) { $ua->proxy('http', $proxy) }; 40 | 41 | $ua->timeout(10); 42 | my $request = new HTTP::Request('GET', "http://tgsv22.nws.noaa.gov/weather/current/$station.html"); 43 | my $response = $ua->request($request); 44 | 45 | if (!$response->is_success) { 46 | return "Something failed in connecting to the NOAA web server. Try again later."; 47 | } 48 | 49 | $content = $response->content; 50 | 51 | if ($content =~ /ERROR/i) { 52 | return "I can't find that station code (see http://weather.noaa.gov/weather/curcond.html for locations codes)"; 53 | } 54 | 55 | $content =~ s|.*?current weather conditions.*?||is; 56 | 57 | $content =~ s|.*?(?:\s*<[^>]+>)*\s*([^<]+)\s<.*?||is; 58 | my $place = $1; 59 | chomp $place; 60 | 61 | $content =~ s|.*?(?:\s*<[^>]+>)*\s*([^<]+)\s<.*?||is; 62 | my $id = $1; 63 | chomp $id; 64 | 65 | $content =~ s|.*?conditions at.*?||is; 66 | 67 | $content =~ s|.*?