Magic-Mirror/gecko-dev
1
0
Fork 0
mirror of https://github.com/mozilla/gecko-dev.git synced 2024-10-09 19:35:51 +00:00
Code Issues Actions Packages Projects Releases Wiki Activity

Updating mozbot to version 2.0: changed to a more modular architecture, added support for multiple channels, added support for multiple nicks, generally cleaned up the code, etc. Uses some code and ideas from timeless and zach.

Browse Source
This commit is contained in:
ian%hixie.ch 2001-04-23 07:07:17 +00:00
parent 66f79b8224
commit 9660807d69
32 changed files with 7617 additions and 1343 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

242
webtools/mozbot/BotModules/Bugzilla.bm Normal file
View File

@ -0,0 +1,242 @@
################################
# Bugzilla Module #
################################
package BotModules::Bugzilla;
use vars qw(@ISA);
@ISA = qw(BotModules);
1;
# there is a minor error in this module: bugsHistory->$target->$bug is
# accessed even when bugsHistory->$target doesn't yet exist. XXX
# This is ported straight from techbot, so some of the code is a little convoluted. So sue me. I was lazy.
# RegisterConfig - Called when initialised, should call registerVariables
sub RegisterConfig {
my $self = shift;
$self->SUPER::RegisterConfig(@_);
$self->registerVariables(
# [ name, save?, settable? ]
['bugsURI', 1, 1, 'http://bugzilla.mozilla.org/'],
['bugsDWIMQueryDefault', 1, 1, 'short_desc_type=substring&short_desc='],
['bugsHistory', 0, 0, {}],
['backoffTime', 1, 1, 120],
['ignoreCommentsTo', 1, 1, ['techbot1']],
['ignoreCommentsFrom', 1, 1, ['|']],
['skipPrefixFor', 1, 1, []],
['mutes', 1, 1, ''], # "channel channel channel"
);
}
sub Help {
my $self = shift;
my ($event) = @_;
my %commands = (
'' => 'The Bugzilla module provides an interface to the bugzilla bug database. It will spot anyone mentioning bugs, too, and report on what they are. For example if someone says \'I think that\'s a dup of bug 5693, the :hover thing\', then this module will display information about bug 5693.',
'bug' => 'Fetches a summary of bugs from bugzilla. Expert syntax: \'bugzilla [bugnumber[,]]*[&bugzillaparameter=value]*\', bug_status: UNCONFIRMED|NEW|ASSIGNED|REOPENED; *type*=substring|; bugtype: include|exclude; order: Assignee|; chfield[from|to|value] short_desc\' long_desc\' status_whiteboard\' bug_file_loc\' keywords\'; \'_type; email[|type][1|2] [reporter|qa_contact|assigned_to|cc]',
'bug-total' => 'Same as bug (which see) but only displays the total line.',
'bugs' => 'A simple DWIM search. Not very clever. ;-) Syntax: \'<query string> bugs\' e.g. \'mozbot bugs\'.'
);
if ($self->isAdmin($event)) {
$commands{'mute'} = 'Disable watching for bug numbers in a channel. Syntax: mute bugzilla in <channel>';
$commands{'unmute'} = 'Enable watching for bug numbers in a channel. Syntax: unmute bugzilla in <channel>';
}
return \%commands;
}
sub Told {
my $self = shift;
my ($event, $message) = @_;
if ($message =~ /^\s*(?:please\s+)?(?:(?:could\s+you\s+)?(?:please\s+)?show\s+me\s+|what\s+is\s+|what's\s+)?bug(?:\s*id)?s?[#\s]+([0-9].*?|&.+?)(?:\s+please)?[?!.]*\s*$/osi) {
my $target = $event->{'target'};
my $bug = $1;
$self->FetchBug($event, $bug, 'bugs', 0, 0);
$self->{'bugsHistory'}->{$target}->{$bug} = time() if $bug =~ /^[0-9]+$/os;
} elsif ($message =~ /^\s*(...+?)\s+bugs\s*$/osi) {
my $target = $event->{'target'};
$self->FetchBug($event, $1, 'dwim', 0, 0);
} elsif ($message =~ /^\s*bug-?total\s+(.+?)\s*$/osi) {
$self->FetchBug($event, $1, 'total', 0, 0);
} elsif ($self->isAdmin($event)) {
if ($message =~ /^\s*mute\s+bugzilla\s+in\s+(\S+?)\s*$/osi) {
$self->{'mutes'} .= " $1";
$self->saveConfig();
$self->say($event, "$event->{'from'}: Watching for bug numbers disabled in channel $1.");
} elsif ($message =~ /^\s*unmute\s+bugzilla\s+in\s+(\S+)\s*$/osi) {
my %mutedChannels = map { $_ => 1 } split(/ /o, $self->{'mutes'});
delete($mutedChannels{$1}); # get rid of any mentions of that channel
$self->{'mutes'} = join(' ', keys(%mutedChannels));
$self->saveConfig();
$self->say($event, "$event->{'from'}: Watching for bug numbers reenabled in channel $1.");
} else {
return $self->SUPER::Told(@_);
}
} else {
return $self->SUPER::Told(@_);
}
return 0; # dealt with it...
}
sub CheckForBugs {
my $self = shift;
my ($event, $message) = @_;
my $bug;
my $skipURI;
if ($message =~ /^(?:.*[]\s,.;:\\\/=?!()<>{}[-])?bug[\s#]*([0-9]+)(?:[]\s,.;:\\\/=?!()<>{}[-].*)?$/osi) {
$bug = $1;
$skipURI = 0;
} elsif ($message =~ /\Q$self->{'bugsURI'}\Eshow_bug.cgi\?id=([0-9]+)(?:[^0-9&].*)?$/si) {
$bug = $1;
$skipURI = 1;
}
if (($bug) and ((not $event->{'channel'}) or ($self->{'mutes'} !~ /^(.*\s|)\Q$event->{'channel'}\E(|\s.*)$/si)) and
(not $self->ignoringCommentsFrom($event->{'from'})) and (not $self->ignoringCommentsTo($message))) {
$self->debug("Noticed someone mention bug $bug -- investigating...");
my $last = 0;
$last = $self->{'bugsHistory'}->{$event->{'target'}}->{$bug} if defined($self->{'bugsHistory'}->{$event->{'target'}}->{$bug});
if ((time()-$last) > $self->{'backoffTime'}) {
$self->FetchBug($event, $bug, 'bugs', $skipURI, 1);
}
$self->{'bugsHistory'}->{$event->{'target'}}->{$bug} = time();
return 1;
} else {
return 0;
}
}
sub Heard {
my $self = shift;
my ($event, $message) = @_;
unless ($self->CheckForBugs($event, $message)) {
return $self->SUPER::Heard(@_);
}
return 0; # we've dealt with it, no need to do anything else.
}
sub Felt {
my $self = shift;
my ($event, $message) = @_;
unless ($self->CheckForBugs($event, $message)) {
return $self->SUPER::Felt(@_);
}
return 0; # we've dealt with it, no need to do anything else.
}
sub Saw {
my $self = shift;
my ($event, $message) = @_;
unless ($self->CheckForBugs($event, $message)) {
return $self->SUPER::Saw(@_);
}
return 0; # we've dealt with it, no need to do anything else.
}
sub FetchBug {
my $self = shift;
my ($event, $bugParams, $type, $skipURI, $skipZaroo) = @_;
my $uri;
if ($type eq 'dwim') {
# XXX should escape query string
$uri = "$self->{'bugsURI'}$self->{'bugsDWIMQueryDefault'}".join(',',split(' ',$bugParams));
$type = 'bugs';
} else {
$uri = "$self->{'bugsURI'}buglist.cgi?bug_id=".join(',',split(' ',$bugParams));
}
$self->getURI($event, $uri, 'bugs', $type, $skipURI, $skipZaroo);
}
sub GotURI {
my $self = shift;
my ($event, $uri, $output, $type, $subtype, $skipURI, $skipZaroo) = @_;
if ($type eq 'bugs') {
my $lots;
my @qp;
# magicness
{ no warnings; # this can go _very_ wrong easily
$lots = ($output !~ /<FORM\s+METHOD=POST\s+ACTION="long_list.cgi">/osi); # if we got truncated, then this will be missing
$output =~ s/<\/TABLE><TABLE .+?<\/A><\/TH>//gosi;
(undef, $output) = split(/Summary<\/A><\/TH>/osi, $output);
($output, undef) = split(/<\/TABLE>/osi, $output);
$output =~ s/[\n\r]//gosi;
@qp = split(/<TR VALIGN=TOP ALIGN=LEFT CLASS=[-A-Za-z0-9]+ ><TD>/osi, $output); }
# loop through output, constructing output string
my @output;
unless (@qp) {
unless ($skipZaroo) {
@output = ('Zarro boogs found.');
} else {
@output = ();
}
} else {
if ($lots) {
@output = ('Way too many bugs found. I gave up so as to not run out of memory. Try to narrow your search or something!');
$subtype = 'lots';
} elsif ($#qp > 1) {
@output = ($#qp.' bugs found.'); # @qp will contain one more item than there are bugs
if ((@qp > 5) and ($event->{'channel'}) and ($subtype ne 'total')) {
$output[0] .= ' Five shown, please message me for the complete list.';
@qp = @qp[0..4];
}
}
if ($subtype eq 'bugs') {
local $" = ', ';
foreach (@qp) {
if ($_) {
# more magic
if (my @d = m|<A HREF="show_bug.cgi\?id=([0-9]+)">\1</A> <td class=severity><nobr>(.*?)</nobr><td class=priority><nobr>(.*?)</nobr><td class=platform><nobr>(.*?)</nobr><td class=owner><nobr>(.*?)</nobr><td class=status><nobr>(.*?)</nobr><td class=resolution><nobr>(.*?)</nobr><td class=summary>(.*)|osi) {
# bugid severity priority platform owner status resolution subject
my $bugid = shift @d;
if ($skipURI) {
push(@output, $self->unescapeXML("Bug $bugid: @d"));
} else {
push(@output, $self->unescapeXML("Bug $self->{'bugsURI'}show_bug.cgi?id=$bugid @d"));
}
$output[$#output] =~ s/, (?:, )+/, /gosi;
$self->{'bugsHistory'}->{$event->{'target'}}->{$d[0]} = time();
}
}
}
}
}
my $prefix;
if (grep({$_ eq $event->{'from'}} @{$self->{'skipPrefixFor'}})) {
# they don't want to have the report prefixed with their name
$prefix = '';
} else {
$prefix = "$event->{'from'}: ";
}
# now send out the output
foreach (@output) {
$self->say($event, "$prefix$_");
}
} else {
return $self->SUPER::GotURI(@_);
}
}
sub ignoringCommentsTo {
my $self = shift;
my ($who) = @_;
foreach (@{$self->{'ignoreCommentsTo'}}) {
return 1 if $who =~ /^(?:.*[]\s,.;:\\\/=?!()<>{}[-])?\Q$_\E(?:[]\s,.;:\\\/=?!()<>{}[-].*)?$/is;
}
return 0;
}
sub ignoringCommentsFrom {
my $self = shift;
my ($who) = @_;
foreach (@{$self->{'ignoreCommentsFrom'}}) {
return 1 if $_ eq $who;
}
return 0;
}

22
webtools/mozbot/BotModules/COPYING Normal file
View File

@ -0,0 +1,22 @@
Unless otherwise stated, the contents of these file are subject to
the Mozilla Public License Version 1.1 (the "License"); you may
not use this file except in compliance with the License. You may
obtain a copy of the License at http://www.mozilla.org/MPL/
Software distributed under the License is distributed on an "AS
IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
implied. See the License for the specific language governing
rights and limitations under the License.
The Original Code is the Bugzilla Bug Tracking System.
The Initial Developer of the Original Code is Netscape
Communications Corporation. Portions created by Netscape are
Copyright (C) 1998 Netscape Communications Corporation. All Rights
Reserved.
Contributor(s): Harrison Page <harrison@netscape.com>
Terry Weissman <terry@mozilla.org>
Risto Kotalampi <risto@kotalampi.com>
Josh Soref <timeless@bemail.org>
Ian Hickson <py8ieh=mozbot@bath.ac.uk>

246
webtools/mozbot/BotModules/FTP.bm Normal file
View File

@ -0,0 +1,246 @@
################################
# FTP Module #
################################
package BotModules::FTP;
use vars qw(@ISA);
use Net::FTP;
@ISA = qw(BotModules);
1;
# RegisterConfig - Called when initialised, should call registerVariables
sub RegisterConfig {
my $self = shift;
$self->SUPER::RegisterConfig(@_);
$self->registerVariables(
# [ name, save?, settable? ]
['host', 1, 1, 'ftp.mozilla.org'],
['path', 1, 1, '/pub/mozilla/nightly/latest'],
['updateDelay', 1, 1, 600],
['preferredLineLength', 1, 1, 80],
['data', 0, 0, {}], # data -> file -> datetime stamp
['mutes', 1, 1, ''], # "channel channel channel"
);
}
# Schedule - called when bot connects to a server, to install any schedulers
# use $self->schedule($event, $delay, $times, $data)
# where $times is 1 for a single event, -1 for recurring events,
# and a +ve number for an event that occurs that many times.
sub Schedule {
my $self = shift;
my ($event) = @_;
$self->schedule($event, \$self->{'updateDelay'}, -1, 'ftp');
$self->SUPER::Schedule($event);
}
sub Help {
my $self = shift;
my ($event) = @_;
my %commands = (
'' => "This module monitors the FTP site 'ftp://$self->{'host'}$self->{'path'}/' and reports new files as they appear.",
'ftp' => 'On its own, lists the currently available files. With a suffix, does a substring search and reports all files matching that pattern. Syntax: \'ftp [pattern]\'',
);
if ($self->isAdmin($event)) {
$commands{'mute'} = 'Disable reporting of new files in a channel. Syntax: mute ftp in <channel>';
$commands{'unmute'} = 'Enable reporting of new files in a channel. Syntax: unmute ftp in <channel>';
}
return \%commands;
}
sub Told {
my $self = shift;
my ($event, $message) = @_;
if ($message =~ /^\s*ftp(?:\s+(\S+?))?\s*\?*\s*$/osi) {
$self->spawnChild($event, \&ftp_check, [$self, $self->{'path'}, $self->{'host'}], 'ftp', [$event, $1]);
} elsif ($self->isAdmin($event)) {
if ($message =~ /^\s*mute\s+ftp\s+in\s+(\S+?)\s*$/osi) {
$self->{'mutes'} .= " $1";
$self->saveConfig();
$self->say($event, "$event->{'from'}: Reporting of new files disabled in channel $1.");
} elsif ($message =~ /^\s*unmute\s+ftp\s+in\s+(\S+)\s*$/osi) {
my %mutedChannels = map { $_ => 1 } split(/ /o, $self->{'mutes'});
delete($mutedChannels{$1}); # get rid of any mentions of that channel
$self->{'mutes'} = join(' ', keys(%mutedChannels));
$self->saveConfig();
$self->say($event, "$event->{'from'}: Reporting of new files reenabled in channel $1.");
} else {
return $self->SUPER::Told(@_);
}
} else {
return $self->SUPER::Told(@_);
}
}
sub Scheduled {
my $self = shift;
my ($event, @data) = @_;
if ($data[0] eq 'ftp') {
$self->spawnChild($event, \&ftp_check, [$self, $self->{'path'}, $self->{'host'}], 'ftp', [undef]);
} else {
$self->SUPER::Scheduled($event, @data);
}
}
# ChildCompleted - Called when a child process has quit
sub ChildCompleted {
my $self = shift;
my ($event, $type, $output, @data) = @_;
if ($type eq 'ftp') {
my @output = split(/\n/os, $output);
if (shift(@output)) {
my @new = ();
while (@output) {
my ($file, $stamp) = (shift(@output), shift(@output));
if ((defined($self->{'data'}->{$file})) and ($self->{'data'}->{$file} < $stamp)) {
push(@new, $file);
}
$self->{'data'}->{$file} = $stamp;
}
if ((defined($self->{'_ready'})) and (scalar(@new))) {
my $s = scalar(@new) > 1 ? 's' : '';
@output = $self->prettyPrint($self->{'preferredLineLength'},
"New file$s in ftp://$self->{'host'}$self->{'path'}/ : ",
'', ' ', @new);
foreach my $channel (@{$self->{'channels'}}) {
unless ($self->{'mutes'} =~ /^(.*\s|)\Q$channel\E(|\s.*)$/si) {
$event->{'target'} = $channel;
foreach (@output) {
$self->say($event, $_);
}
}
}
}
$self->{'_ready'} = 1;
if ($data[0]) {
$self->ftp_stamp($event, $data[1]);
}
} else {
if ($data[0]) {
$self->say($event, "I could not contact $self->{'host'}, sorry.");
}
$self->tellAdmin($event, "Dude, I'm having a problem with FTP. Could you prod $self->{'host'} for me please? Or fix my config? Cheers.");
}
} else {
$self->SUPER::ChildCompleted($event, $type, $output, @data);
}
}
# The following is directly from the original techbot (mozbot 1.5), written by timeless.
# The only changes I made were to port it to the mozbot2 architecture. Those changes
# are commented.
sub day_str {
my (@stamp,$ahr,$amn,$asc);
($asc, $amn, $ahr, @stamp)=gmtime($_[3]);
$asc = "0$asc" if $asc < 10; # \
$amn = "0$amn" if $amn < 10; # -- added these to zero-pad output
$ahr = "0$ahr" if $ahr < 10; # /
return "$_[4] ($ahr:$amn:$asc) " # added extra space to neaten output
if ($stamp[0]==$_[0] && $stamp[1]==$_[1] && $stamp[2]==$_[2]);
}
sub ftp_stamp {
# It seems that the original wanted ($to, $cmd, $rest) as the arguments.
# However, it doesn't use $to except at the end (which we replace) and
# it doesn't use $cmd at all. This is lucky for us, since the first
# argument of methods is always the object ref.
my $self = $_[0];
# This function also expects to be able to use a global (!) variable
# called %latestbuilds. We grandfather that by making a lexically scoped
# copy of one of our object fields.
my %latestbuilds = %{$self->{'data'}};
# We have to keep a copy of $event around for when we send out the
# output, of course. So let's use the second argument for that:
my $event = $_[1];
# Finally, we have to work around a serious bug in the original version,
# which assumed any pattern input was valid regexp. [XXX use eval]
$_[2] = defined($_[2]) ? quotemeta($_[2]) : 0;
# In summary, call this function like this:
# $self->ftp_stamp($event, $pattern);
my @day=gmtime(time); my @tm=@day[0..2]; @day=@day[3..5];
my (@filestamp, $filelist, $ahr,$amn,$asc);
if ($_[2]){ # this code's output is *VERY* ugly. But I just took it as is, so deal with it. Patches welcome.
foreach my $filename (keys %latestbuilds){
my @ltm=gmtime($latestbuilds{$filename});
$filelist.="$filename [".($ltm[5]+1900).'-'.($ltm[4]+1)."-$ltm[3] $ltm[2]:$ltm[1]:$ltm[0]]"
if $filename=~/$_[2]/;
}
$filelist=$filelist||'<nothing matched>';
$filelist="Files matching re:$_[2] [gmt] $filelist";
}else{
foreach my $filename (keys %latestbuilds){
$filelist.=day_str(@day[0..2],$latestbuilds{$filename},$filename);
}
if ($filelist){
$filelist="Files from today [gmt] $filelist";
} else {
foreach my $filename (keys %latestbuilds){
@day=gmtime(time-86400); @day=@day[3..5];
$filelist.=day_str(@day[0..2],$latestbuilds{$filename},$filename);
}
$filelist="Files from yesterday [gmt] $filelist"|| # next line changed from " to \' and added missing '>'
'<No files in the past two days by gmt, try \'ftp .\' for a complete filelist>';
}
}
# Append the current time for those not in GMT time zones
my @time;
foreach (@tm) {
# zero pad the time
$_ = "0$_" if $_ < 10;
# switch digits around (@tm is in reverse order)
unshift(@time, $_);
}
# output
local $";
$" = ':';
$filelist .= " time now: @time";
# Ok, now we want to send out the results (held in $filelist).
$self->say($event, $filelist);
}
sub ftp_check {
# ok, this function has been hacked for the new architecture.
# ftp_check is called in a spawned child.
# It returns the output in a fixed format back to the parent
# process. The format is
# 1
# file
# timestamp
# file
# timestamp
# if it fails, the '1' will be missing (no output).
# It should be passed the following arguments:
# [$self, $path, $server]
my $self = $_[0];
my $output = '';
my $buf='';
my $mdtms;
my $ftpserver=$_[2];
my $ftp = new Net::FTP($ftpserver, Debug => 0, Passive => 1);
if ($ftp){
$output .= "1\n"; # how we find out if it worked or not
if ($ftp->login('anonymous','mozbot@localhost')){
$ftp->cwd($_[1]); # path used to be hardcoded
for my $f ($ftp->ls){
$mdtms=$ftp->mdtm($f);
$output .= "$f\n$mdtms\n"; # output to pipe instead of irc
}
$ftp->quit;
};
}
# now send out the buffered output
return $output;
}

83
webtools/mozbot/BotModules/Filter.bm Normal file
View File

@ -0,0 +1,83 @@
################################
# Filter Module #
################################
# The canonical filters should be installed on your path somewhere.
# You can get the source from these from your local distributor.
package BotModules::Filter;
use vars qw(@ISA);
use IPC::Open2;
@ISA = qw(BotModules);
1;
my @Filters = (
'b1ff',
'chef',
'cockney',
'eleet',
'jethro',
'jibberish',
'jive',
'kraut',
'nyc',
'rasterman',
'upside-down',
);
sub Help {
my $self = shift;
my ($event) = @_;
my $reply = {
'' => 'This module is an interface to the text filter applications.',
};
foreach (@Filters) {
$reply->{$_} = "Pass the text through the $_ filter. Syntax: $_ <text>";
}
if ($self->isAdmin($event)) {
$reply->{'filtersay'} = "Pass text through a filter and send it to a channel. Syntax: filtersay <filter> <channel> <text>";
}
return $reply;
}
sub Told {
my $self = shift;
my ($event, $message) = @_;
foreach (@Filters) {
if ($message =~ /^\s*\Q$_\E\s+(.+?)\s*$/si) {
$self->spawnChild($event, sub { return $self->Filter(@_); }, [$_, $1], 'filter', []);
return 0; # we've dealt with it, no need to do anything else.
} elsif (($message =~ /^\s*filtersay\s+\Q$_\E\s+(\S+)\s+(.+?)\s*$/si) and ($self->isAdmin($event))) {
$self->spawnChild($event, sub { return $self->Filter(@_); }, [$_, $2], 'filter', [$1]);
return 0; # we've dealt with it, no need to do anything else.
}
}
return $self->SUPER::Told(@_);
}
sub Filter {
my $self = shift;
my($filter, $text) = @_;
my $reader;
my $writer;
local $/ = undef;
my $pid = open2($reader, $writer, $filter);
print $writer $text;
close($writer);
my $reply = <$reader>;
close($reader);
waitpid($pid, 0);
return $reply;
}
# ChildCompleted - Called when a child process has quit
sub ChildCompleted {
my $self = shift;
my ($event, $type, $output, @data) = @_;
if ($type eq 'filter') {
local $event->{'target'} = $data[0] if defined($data[0]);
$self->say($event, $output);
} else {
return $self->SUPER::ChildCompleted(@_);
}
}

119
webtools/mozbot/BotModules/FortuneCookies.bm Normal file
View File

@ -0,0 +1,119 @@
################################
# Fortune Cookie Module #
################################
package BotModules::FortuneCookies;
use vars qw(@ISA);
@ISA = qw(BotModules);
1;
sub Help {
my $self = shift;
my ($event) = @_;
return {
'' => 'A module to get random fortune cookies.',
'fortune' => 'Same as \'cookie\', which see.',
'cookie' => 'To get a fortune cookie, just tell me \'cookie\'. To set a new fortune cookie, see \'new\'. To find out how many cookies are left, use \'cookie status\'.',
'new' => 'To set a new fortune cookie, say \'new cookie\' followed by the text, e.g. \'new cookie: you will have a nice day\' or whatever. The string %from% will be replaced by the name of whoever requests the cookie.',
'fetch' => 'The command \'fetch cookies from <uri>\' will add each line in <uri> to the cookie list. Cookie lists must start with one line that reads \'FORTUNE COOKIE FILE\'. Blank lines and lines starting with a hash (\'#\') are ignored.',
};
}
# RegisterConfig - Called when initialised, should call registerVariables
sub RegisterConfig {
my $self = shift;
$self->SUPER::RegisterConfig(@_);
$self->registerVariables(
# [ name, save?, settable? ]
['cookies', 1, 1, ['The sun will rise in the east today, indicating nothing in particular.']],
['cookiesIndex', 1, 1, 0],
['cookiesLeft', 0, 1, 10],
['bakingTime', 1, 1, 20],
['cookiesMax', 1, 1, 10],
);
}
# Schedule - called when bot connects to a server, to install any schedulers
# use $self->schedule($event, $delay, $times, $data)
# where $times is 1 for a single event, -1 for recurring events,
# and a +ve number for an event that occurs that many times.
sub Schedule {
my $self = shift;
my ($event) = @_;
$self->schedule($event, \$self->{'bakingTime'}, -1, 'newCookie');
$self->SUPER::Schedule($event);
}
sub Told {
my $self = shift;
my ($event, $message) = @_;
if ($message =~ /^\s*(?:please[,.!1?]*\s+)?(?:(?:can|could)\s+i\s+have\s+a\s+|give\s+me\s+a\s+)?(?:fortune\s+cookie|fortune|cookie)(?:[,!1.\s]+now)?(?:[,!1.\s]+please)?\s*[?!1.]*\s*$/osi) {
if ($self->{'cookiesLeft'} > 0) {
$self->{'cookiesLeft'}--;
my $cookie = $self->GetNext('cookies');
$cookie =~ s/%from%/$event->{'from'}/gos;
$self->say($event, $cookie);
} else {
$self->say($event, 'I\'m sorry, I\'ve run out of cookies! You\'ll have to wait for me to bake some more.');
}
} elsif ($message =~ /^\s*new\s+(?:fortune\s+cookie|fortune|cookie)[-!:,;.\s]+(.....+?)\s*$/osi) {
push(@{$self->{'cookies'}}, $1);
my $count = scalar(@{$self->{'cookies'}});
$self->say($event, "$event->{'from'}: Thanks! I have added that fortune cookie to my recipe book. I now have $count fortunes!");
$self->saveConfig();
} elsif ($message =~ /^\s*cookie\s+(?:report|status|status\s+report)(?:\s+please)?[?!.1]*\s*$/osi) {
my $count = scalar(@{$self->{'cookies'}});
$self->say($event, "My cookie basket has $self->{'cookiesLeft'} cookies left out of possible $self->{'cookiesMax'}. I have $count fortunes in my recipe book.");
} elsif ($message =~ /^\s*fetch\s+cookies\s+from\s+(.+?)\s*$/osi) {
$self->getURI($event, $1, 'cookies');
} else {
return $self->SUPER::Told(@_);
}
return 0; # we've dealt with it, no need to do anything else.
}
sub GetNext {
my $self = shift;
my ($list) = @_;
$self->{"${list}Index"} = 0 if $self->{"${list}Index"} > $#{$self->{$list}};
my $reply = $self->{$list}->[$self->{"${list}Index"}++];
# should add some deterministic way of making the output appear more random here XXX
$self->saveConfig();
return $reply;
}
sub Scheduled {
my $self = shift;
my ($event, @data) = @_;
if ($data[0] eq 'newCookie') {
$self->{'cookiesLeft'}++ unless $self->{'cookiesLeft'} >= $self->{'cookiesMax'};
} else {
$self->SUPER::Scheduled($event, @data);
}
}
sub GotURI {
my $self = shift;
my ($event, $uri, $output, $type) = @_;
if ($type eq 'cookies') {
my @output = split(/[\n\r]+/os, $output);
if ((@output) and ($output[0] eq 'FORTUNE COOKIE FILE')) {
my $count = 0;
foreach (@output[1..$#output]) {
if (/^[^#].+$/os) {
push(@{$self->{'cookies'}}, $_);
$count++;
}
}
my $total = scalar(@{$self->{'cookies'}});
my $s = $count > 1 ? 's' : '';
$self->say($event, "$event->{'from'}: Thanks! I have added $count fortune cookie$s to my recipe book. I now have $total fortunes!");
$self->saveConfig();
} else {
$self->say($event, "$event->{'from'}: Sorry, but that's not a fortune cookie file.");
}
} else {
return $self->SUPER::GotURI(@_);
}
}

301
webtools/mozbot/BotModules/God.bm Normal file
View File

@ -0,0 +1,301 @@
################################
# God Module #
################################
package BotModules::God;
use vars qw(@ISA);
@ISA = qw(BotModules);
1;
sub Help {
my $self = shift;
my ($event) = @_;
my $answer = {
'' => 'A per-channel auto-opper.',
'ops' => 'Lists the autoop list for a channel. Syntax: \'ops in <channel>\'',
'opme' => 'Checks the autoop list, and ops the speaker if they are on the autoop list. Must be used in a channel. Syntax: \'op me\' or \'opme\'',
'mask' => 'Add or remove a regexp mask from a channel\'s autoop list. Only bot and channel admins can do this. USE OF THIS FEATURE IS HIGHLY DISCOURAGED AS IT IS VERY INSECURE!!! Syntax: \'add mask <user@host> in <channel>\' to add and \'remove mask <user@host> in <channel>\' to remove. The special word \'everywhere\' can be used instead of a channel name to add a mask that works in all channels.',
'autoop' => 'Add someone to the autoop list for a channel. Only bot and channel admins can do this. Syntax: \'op <user> in <channel>\'',
'deautoop' => 'Remove someone from the autoop list for a channel. Only bot and channel admins can do this. Syntax: \'deop <user> in <channel>\'',
'enable' => 'Enable a module in a channel. Only bot and channel admins can do this. Syntax: \'enable <module> in <channel>\'',
'disable' => 'Disable a module in a channel. Only bot and channel admins can do this. Syntax: \'disable <module> in <channel>\'',
};
if ($self->isAdmin($event)) {
$answer->{'opme'} .= '. As an administrator, you can also say \'op me in <channel>\' or \'op me everywhere\' which will do the obvious things.';
$answer->{'promote'} = 'Add someone to the channel admin list for a channel. Only bot admins can do this. Syntax: \'promote <user> in <channel>\'',
$answer->{'demote'} = 'Remove someone from the channel admin list for a channel. Only bot admins can do this. Syntax: \'demote <user> in <channel>\'',
}
return $answer;
}
# RegisterConfig - Called when initialised, should call registerVariables
sub RegisterConfig {
my $self = shift;
$self->SUPER::RegisterConfig(@_);
$self->registerVariables(
# [ name, save?, settable? ]
['channelAdmins', 1, 1, {}],
['channelOps', 1, 1, {}],
['channelOpMasks', 1, 1, {}],
['kickLog', 1, 1, []],
['allowPrivateOpRequests', 1, 1, 1],
['maxInChannel', 1, 1, 4],
);
}
sub Told {
my $self = shift;
my ($event, $message) = @_;
if ($event->{'level'} == 1) {
if ($message =~ /^\s*(?:list\s+)?ops\s+(?:in\s+|for\s+)?(\S+)\s*\??$/osi) {
my $channel = lc($1);
$self->listOps($event, $channel);
} elsif ($message =~ /^\s*autoop\s+(\S+)\s+in\s+(\S+)\s*$/osi) {
if (($self->isChannelAdmin($event, $2)) or ($self->isAdmin($event))) {
my $channel = $2 eq 'everywhere' ? '' : lc($2);
$self->{'channelOps'}->{$channel} .= " $1";
$self->saveConfig();
$self->say($event, "$event->{'from'}: User '$1' added to the autoop list of channel '$2'.");
} else {
$self->say($event, "$event->{'from'}: Only channel administrators may add people to a channel's autoop list.");
}
} elsif ($message =~ /^\s*deautoop\s+(\S+)\s+in\s+(\S+)\s*$/osi) {
if (($self->isChannelAdmin($event, $2)) or ($self->isAdmin($event))) {
my $channel = $2 eq 'everywhere' ? '' : lc($2);
my %people = map { $_ => 1 } split(/ +/os, $self->{'channelOps'}->{$channel});
delete($people{$1}); # get rid of any mentions of that person
$self->{'channelOps'}->{$channel} = join(' ', keys(%people));
$self->saveConfig();
$self->say($event, "$event->{'from'}: User '$1' removed from the autoop list of channel '$2'.");
} else {
$self->say($event, "$event->{'from'}: Only channel administrators may remove people from a channel's autoop list.");
}
} elsif ($message =~ /^\s*add\s+mask\s+(\S+)\s+(?:in|to|for|from)\s+(\S+)\s*$/osi) {
if (($self->isChannelAdmin($event, $2)) or ($self->isAdmin($event))) {
my $channel = $2 eq 'everywhere' ? '' : lc($2);
$self->{'channelOpMasks'}->{$channel} .= " $1";
$self->saveConfig();
$self->say($event, "$event->{'from'}: Mask '$1' added to the autoop list of channel '$2'.");
} else {
$self->say($event, "$event->{'from'}: Only channel administrators may add masks to a channel's autoop list.");
}
} elsif ($message =~ /^\s*remove\s+mask\s+(\S+)\s+(?:in|from|for|to)\s+(\S+)\s*$/osi) {
if (($self->isChannelAdmin($event, $2)) or ($self->isAdmin($event))) {
my $channel = $2 eq 'everywhere' ? '' : lc($2);
my %people = map { $_ => 1 } split(/ +/os, $self->{'channelOpMasks'}->{$channel});
delete($people{$1}); # get rid of any mentions of that person
$self->{'channelOpMasks'}->{$channel} = join(' ', keys(%people));
$self->saveConfig();
$self->say($event, "$event->{'from'}: Mask '$1' removed from the autoop list of channel '$2'.");
} else {
$self->say($event, "$event->{'from'}: Only channel administrators may remove masks from a channel's autoop list.");
}
} elsif ($message =~ /^\s*promote\s+(\S+)\s+in\s+(\S+)\s*$/osi) {
if ($self->isAdmin($event)) {
$self->{'channelAdmins'}->{lc($2)} .= " $1";
$self->saveConfig();
$self->say($event, "$event->{'from'}: User '$1' promoted to channel administrator status in channel '$2'.");
} else {
$self->say($event, "$event->{'from'}: Only administrators may promote people to channel admin status.");
}
} elsif ($message =~ /^\s*demote\s+(\S+)\s+in\s+(\S+)\s*$/osi) {
if ($self->isAdmin($event)) {
my %people = map { $_ => 1 } split(/ +/os, $self->{'channelAdmins'}->{lc($2)});
delete($people{$1}); # get rid of any mentions of that person
$self->{'channelAdmins'}->{lc($2)} = join(' ', keys(%people));
$self->saveConfig();
$self->say($event, "$event->{'from'}: User '$1' removed from the channel administrator list of channel '$2'.");
} else {
$self->say($event, "$event->{'from'}: Only administrators may remove people's channel admin status.");
}
} elsif ($message =~ /^\s*enable\s+(\S+)\s+in\s+(\S+)\s*$/osi) {
if (($self->isAdmin($event)) or ($self->isChannelAdmin($event, $2))) {
my $module = $self->getModule($1);
if ($1) {
push(@{$module->{'channels'}}, lc($2));
$module->saveConfig();
$self->say($event, "$event->{'from'}: Module '$1' enabled in channel '$2'.");
} else {
$self->say($event, "$event->{'from'}: There is no module called '$1', sorry.");
}
} else {
$self->say($event, "$event->{'from'}: Only channel administrators may change a module's status.");
}
} elsif ($message =~ /^\s*disable\s+(\S+)\s+in\s+(\S+)\s*$/osi) {
if (($self->isAdmin($event)) or ($self->isChannelAdmin($event, $2))) {
my $module = $self->getModule($1);
if ($1) {
my %channels = map { $_ => 1 } @{$module->{'channels'}};
delete($channels{lc($2)}); # get rid of any mentions of that channel
@{$module->{'channels'}} = keys %channels;
$module->saveConfig();
$self->say($event, "$event->{'from'}: Module '$1' disabled in channel '$2'.");
} else {
$self->say($event, "$event->{'from'}: There is no module called '$1', sorry.");
}
} else {
$self->say($event, "$event->{'from'}: Only channel administrators may change a module's status.");
}
} elsif ($message =~ /^\s*(?:(?:(?:de)?autoop|promote|demote|enable|disable|add\s+mask|remove\s+mask)\s+(\S+)|(?:list\s+)?ops)\s*$/osi) {
$self->say($event, "$event->{'from'}: You have to give a channel, as in \'<command> <who> in <channel>\'.");
# XXX next two could be merged, maybe.
} elsif ($message =~ /^\s*op\s*meh?[!1.,]*\s*(?:please|(b+[iea]+t+c+h+))?\s*[.!1]*\s*$/osi) {
if ($event->{'userName'}) {
if ($event->{'channel'}) {
unless ($self->checkOpping($event, $event->{'channel'}, $event->{'from'}, $self->isAdmin($event))) {
if ($1) {
$self->say($event, "$event->{'from'}: No way, beetch!");
} else {
$self->say($event, "$event->{'from'}: Sorry, you are not on my auto-op list.");
}
}
} else {
$self->say($event, "$event->{'from'}: You have to use this command in public.");
}
} else {
$self->say($event, "$event->{'from'}: You haven't authenticated yet. See 'help auth' for details.");
}
} elsif ($message =~ /^\s*(?:please\s+)?op\s*me(?:\s+in\s+(\S+)|\s+everywhere)?[\s!1.]*\s*$/osi) {
if (($self->{'allowPrivateOpRequests'}) or ($self->isAdmin($event))) {
if ($1) {
$self->checkOpping($event, lc($1), $event->{'from'}, $self->isAdmin($event));
} else {
foreach (@{$self->{'channels'}}) {
$self->checkOpping($event, $_, $event->{'from'}, $self->isAdmin($event));
}
}
} else {
$self->say($event, "$event->{'from'}: Sorry, but no. Try \'help opme\' for details on commansyntax.");
}
} else {
my $parentResult = $self->SUPER::Told(@_);
return $parentResult < 2 ? 2 : $parentResult;
}
return 0; # we've dealt with it, no need to do anything ese.
} elsif ($event->{'level'} == 2) {
if (defined($event->{'God_channel'})) {
$event->{'God_channel_rights'} = $self->isChannelAdmin($event, $event->{'God_channel'});
}
}
return $self->SUPER::Told(@_);
}
# SpottedJoin - Called when someone joins a channel
sub SpottedJoin {
my $self = shift;
my ($event, $channel, $who) = @_;
$self->checkOpping(@_, 0);
return $self->SUPER::SpottedJoin(@_); # this should not stop anything else happening
}
# do all channels when someone authenticates
sub Authed {
my $self = shift;
my ($event, $who) = @_;
foreach (@{$self->{'channels'}}) {
$self->checkOpping($event, $_, $who, 0);
}
return $self->SUPER::Authed(@_); # this should not stop anything else happening
}
# check is someone is in the opping.
sub checkOpping {
my $self = shift;
my ($event, $channel, $who, $override) = @_;
if (($self->isAutoopped($event, $channel)) or ($self->isChannelAdmin($event, $channel)) or ($override)) {
$self->mode($event, $channel, '+o', $who);
return 1;
}
return 0;
}
sub isChannelAdmin {
my $self = shift;
my ($event, $channel) = @_;
return (($event->{'userName'}) and
(defined($self->{'channelAdmins'}->{$channel})) and
($self->{'channelAdmins'}->{$channel} =~ /^(|.*\s+)$event->{'userName'}(\s+.*|)$/s));
}
sub isAutoopped {
my $self = shift;
my ($event, $channel) = @_;
return ((($event->{'userName'}) and
(defined($self->{'channelOps'}->{$channel})) and
(($self->{'channelOps'}->{$channel} =~ /^(|.*\s+)$event->{'userName'}(\s+.*|)$/s) or
($self->{'channelOps'}->{''} =~ /^(|.*\s+)$event->{'userName'}(\s+.*|)$/s))) or
($self->isMatchedByMask($event, $channel)));
}
# grrrr -- this insecure feature is here by popular demand
sub isMatchedByMask {
my $self = shift;
my ($event, $channel) = @_;
my $masks;
$masks .= $self->{'channelOpMasks'}->{$channel} if defined($self->{'channelOpMasks'}->{$channel});
$masks .= ' '.$self->{'channelOpMasks'}->{''} if defined($self->{'channelOpMasks'}->{''});
if (defined($masks)) {
my @masks = split(/ +/os, $masks);
my $user = $event->{'user'};
foreach my $regexp (@masks) {
my $pattern = $self->sanitizeRegexp($regexp);
return 1 if ($pattern !~ /^[\s.*+]*$/) and ($user =~ /$pattern/si);
}
}
return 0;
}
sub Kicked {
my $self = shift;
my ($event, $channel) = @_;
push(@{$self->{'kickLog'}}, "$event->{'from'} kicked us from $channel"); # XXX karma or something... ;-)
return $self->SUPER::Kicked(@_);
}
sub getList {
my $self = shift;
my ($channel, $list) = @_;
my $data;
my @list;
$data = defined($self->{$list}->{$channel}) ? $self->{$list}->{$channel} : '';
$data .= defined($self->{$list}->{''}) ? ' '.$self->{$list}->{''} : '';
if ($data =~ /^\s*$/os) {
@list = ('(none)');
} else {
@list = sort(split(/\s+/os, $data));
while ((@list) and ($list[0] =~ /^\s*$/)) { shift @list; }
}
return @list;
}
sub listOps {
my $self = shift;
my ($event, $channel) = @_;
my @admins = $self->getList($channel, 'channelAdmins');
my @ops = $self->getList($channel, 'channelOps');
my @masks = $self->getList($channel, 'channelOpMasks');
local $" = ' ';
my @output = ();
push(@output, "$channel admins: @admins");
push(@output, "$channel ops: @ops");
if (@masks > 2) {
push(@output, "$channel autoop masks:");
foreach (@masks) {
push(@output, " $_");
}
} else {
push(@output, "$channel autoop masks: @masks");
}
if (scalar(@output) > $self->{'maxInChannel'}) {
foreach (@output) {
$self->directSay($event, $_);
}
$self->channelSay($event, "$event->{'from'}: long list /msg'ed");
} else {
foreach (@output) {
$self->say($event, "$event->{'from'}: $_");
}
}
}

255
webtools/mozbot/BotModules/Greeting.bm Normal file
View File

@ -0,0 +1,255 @@
################################
# Greeting Module #
################################
package BotModules::Greeting;
use vars qw(@ISA);
@ISA = qw(BotModules);
1;
# SpottedNickChange would be a nice one to do if you
# can solve the problem of working out which channel
# to say stuff in...
sub Help {
my $self = shift;
my ($event) = @_;
return {
'' => 'A polite module for saying hello and goodbye and so on.',
'hi' => 'To greet the bot.',
'bye' => 'To say good bye to the bot.',
'ping' => 'To check the bot is alive.',
'uptime' => 'Gives the amount of time that the bot has been active.',
};
}
# RegisterConfig - Called when initialised, should call registerVariables
sub RegisterConfig {
my $self = shift;
$self->SUPER::RegisterConfig(@_);
$self->registerVariables(
# [ name, save?, settable? ]
['greetings', 1, 1, ['hi %', 'yo %', 'salut %', '%! dude!', '%: hello', '%', 'bonjour %']],
['greetingsIndex', 1, 1, 0],
['byes', 1, 1, ['seeya %', 'bye %', 'night %', '/me waves goodbye to %']],
['byesIndex', 1, 1, 0],
['ow', 1, 1, ['%!! stop it!!', '%? You want something?', 'I\'m working! Leave me alone!', 'ow!', 'Leave me out of it!', '%: mean!']],
['owIndex', 1, 1, 0],
['veryow', 1, 1, ['OOOOWWWW!!!', 'GETOFF!!!', '/me fights back', 'Yikes! I\'m being attacked!!', '/me hits % over the head with a 2-by-4']],
['veryowIndex', 1, 1, 0],
['yousuck', 1, 1, ['%: no, *you* suck!', '/me pouts', '/me cries']],
['yousuckIndex', 1, 1, 0],
['thanks', 1, 1, ['sure thing %', 'np', '%: np', '%: just doing my job!']],
['thanksIndex', 1, 1, 0],
['listen', 1, 1, ['(*', '%: I\'m listening.', '%?']],
['listenIndex', 1, 1, 0],
['unhappy', 1, 1, [':)', '/me cries', 'but... but...', '/me is all sad', ':(']],
['unhappyIndex', 1, 1, 0],
['happy', 1, 1, [':)', '/me smiles']],
['happyIndex', 1, 1, 0],
['vhappy', 1, 1, ['OOoh! %!', 'I love you too, %.']],
['vhappyIndex', 1, 1, 0],
['whoami', 1, 1, 'I am a bot. /msg me the word \'help\' for a list of commands.'],
['lastrheet', 0, 0, 0], # time of last rheet
['rheetbuffer', 1, 1, 10], # max of 1 rheet per this many seconds
['rheetMaxEs', 1, 1, 100], # number of es at which to stop responding.
['autoGreetMute', 1, 1, []], # channels to mute in
['autoGreetings', 1, 1, {}], # people to greet and their greeting
['autoGreeted', 0, 0, {}], # people to NOT greet, and the last time
['autoGreetedBackoffTime', 1, 1, 20], # how long to not greet people (seconds)
['evil', 1, 1, ['c++ is evil', '/me mumbles something about c++ being evil', 'c++ is e-- ah, nevermind.', 'c++ sucks', '/me frowns at %']],
['evilIndex', 1, 1, 0],
['evilBackoffTime', 1, 1, 36000], # how long to not insult c++ (10 hours by default)
['lastEvil', 1, 0, 0], # when the last c++ insult took place
['assumeThanksTime', 1, 1, 10], # how long to assume that thanks are directed to us after hearing from them (seconds)
['_lastSpoken', 0, 0, {}], # who has spoken to us
);
}
sub Told {
my $self = shift;
my ($event, $message) = @_;
$self->{'_lastSpoken'}->{$event->{'user'}} = time();
my $me = quotemeta($event->{'bot'}->nick);
my $expandedme = join('+', split(//gos, $me)).'+';
if ($message =~ /^\s*(?:mornin[g']?|hi|heya?|w+a+[sz]+u+p+|hello|greetings|yo(?:\s+dude)?|m+[ay]+(?:\s+m+a+i+n+)?\s+m+a+n+|d+u+d+e+)[?!1.\s]*$/osi) {
if ($self->canGreet($event)) {
$self->Perform($event, 'greetings');
}
} elsif ($message =~ /^\s*(?:bye|'?night|seeya)[?!1.\s]*$/osi) {
$self->Perform($event, 'byes');
} elsif ($message =~ /^\s*say[\s:,"']+(hi|hello|good\s*bye|seeya)(?:\s+to\s+(\S+))(?:[,\s]*please)?[?!1.\s]*$/osi) {
if ($2) {
$self->say($event, "$2: $1");
} else {
$self->say($event, "$1");
}
} elsif ($message =~ /^\s*(?:you\s+(?:really\s+)?suck(?:\s+hard|(?:\s+big)?\s+rocks)?|you(?:\s+a|')re\s+an\s+idiot|i\s+hate\s+you)[?!1.\s]*\s*$/osi) {
$self->Perform($event, 'yousuck');
} elsif ($message =~ /^\s*(?:oh[!1?.,\s]*)?(?:thanks|cheers)[\s!1.]*(?:[;:8][-o]?[]()\|O0<>[]\s*)?$/osi) {
$self->Perform($event, 'thanks');
} elsif ($message =~ /^\s*(?::-?\)|good\s+bot[.!1\s]*|you\s+rock|have\s+a\s+bot\s*snack[.!1\s]*)\s*(?:[;:8][-o]?[]()\|O0<>[]\s*)?$/osi) {
$self->Perform($event, 'happy');
} elsif ($message =~ /^\s*(?:i|we)\s+love\s+you\s*[.!1]*\s*(?:[;:8][-o]?[]()\|O0<>[]\s*)?$/osi) {
$self->Perform($event, 'happy');
} elsif ($message =~ /^\s*die[!1.\s]*$/osi) {
$self->Perform($event, 'unhappy');
} elsif ($message =~ /^\s*(?:how\s+are\s+you|how\s+do\s+you\s+do|how'?s\s+things|are\s+you\s+ok)(?:[?!1.,\s]+$expandedme)?\s*[?!1.\s]*$/osi) {
$uptime = $self->days($^T);
$self->say($event, "$event->{'from'}: fine thanks! I've been up $uptime so far!");
} elsif ($message =~ /^\s*(?:who\s+are\s+you)\s*[?!1.\s]*$/osi) {
$self->say($event, "$event->{'from'}: $self->{'whoami'}");
} elsif ($message =~ /^\s*up\s*(?:time)?[?!1.\s]*$/osi) {
$uptime = $self->days($^T);
$self->say($event, "$event->{'from'}: I've been up $uptime.");
} elsif ($message =~ /^\s*r+h(e+)t+[!1.\s]*\s*$/osi) {
if (length($1) < $self->{'rheetMaxEs'}) {
$self->say($event, "$event->{'from'}: rhe$1$1t!");
} else {
$self->say($event, "$event->{'from'}: uh, whatever.");
}
} elsif ($message =~ /^\s*ping\s*$/osi) {
$self->say($event, "$event->{'from'}: pong");
# XXX CCTP ping $event->{'from'}
} else {
return $self->SUPER::Told(@_);
}
return 0; # we've dealt with it, no need to do anything else.
}
sub Heard {
my $self = shift;
my ($event, $message) = @_;
my $me = quotemeta($event->{'bot'}->nick);
my $expandedme = join('+', split(//gos, $me)).'+';
if ($message =~ /^\s*(?:(?:hi|heya?|w+a+s+u+p+|hello|mornin[g']?|greetings|yo(?:\s+yo)*|bonjour|hoi)\s+$me|$expandedme\s*)!*1*\s*$/si) {
if ($self->canGreet($event)) {
$self->Perform($event, 'greetings');
}
} elsif ($message =~ /^\s*(?:bye|night|seeya|ciao)\s+$me\s*[!1.]*\s*$/si) {
$self->Perform($event, 'byes');
} elsif ($message =~ /^\s*(?:oh[!1?,.\s]*)?(?:thanks|cheers)\s+$me[\s!1.]*(?:[;:8][-o]?[]()\|O0<>[]\s*)?$/si) {
$self->Perform($event, 'thanks');
} elsif (($message =~ /^\s*(?:oh[!1?,.\s]*)?(?:thanks|cheers)[\s!1.]*(?:[;:8][-o]?[]()\|O0<>[]\s*)?$/si) and ($self->canAssumeThanks($event))) {
$self->Perform($event, 'thanks');
} elsif (($message =~ /^\s*(?:good\s+bot)[!1.\s]*(?:[;:8][-o]?[]()\|O0<>[]\s*)?$/si) and ($self->canAssumeThanks($event))) {
$self->Perform($event, 'happy');
} elsif (($message =~ /^\s*(?:you\s+(?:really\s+)?suck(?:\s+hard|(?:\s+big)?\s+rocks)?|you(?:\s+a|')re\s+an\s+idiot|i\s+hate\s+you)[?!1.\s]*\s*$/osi) and
($self->canAssumeThanks($event))) {
$self->Perform($event, 'yousuck');
} elsif ($message =~ /^\s*(?:good|yay[\s!1.]*)\s+$me[\s!1.]*(?:[;:8][-o]?[]()\|O0<>[]\s*)?$/si) {
$self->Perform($event, 'happy');
} elsif ($message =~ /^\s*(?:$me\s*[.?\/]+)\s*$/si) {
$self->Perform($event, 'listen');
} elsif ($message =~ /^\s*r+h(e+)t+[!1.\s]*\s*$/osi) {
if ((time()-$self->{'lastrheet'}) > $self->{'rheetbuffer'}) {
if (length($1) < $self->{'rheetMaxEs'}) {
$self->say($event, "rhe$1$1t!");
}
$self->{'lastrheet'} = time();
}
} elsif ($message =~ /^.+\s+c\+\+\s+.+$/osi) {
if ((time() - $self->{'lastEvil'}) > $self->{'evilBackoffTime'}) {
$self->{'lastEvil'} = time();
$self->Perform($event, 'evil'); # calls GetNext which calls saveConfig
}
} else {
return $self->SUPER::Heard(@_);
}
return 0; # we've dealt with it, no need to do anything else.
}
sub Felt {
my $self = shift;
my ($event, $message) = @_;
my $me = quotemeta($event->{'bot'}->nick);
if ($message =~ /^\s*(?:pokes|prods)\s+$me\s*[!1.]*\s*$/si) {
$self->Perform($event, 'ow');
} elsif ($message =~ /^\s*(?:stabs|slaps|kicks|kills|hits|punches)\s+$me\s*[!1.]*\s*$/si) {
$self->Perform($event, 'veryow');
} elsif ($message =~ /^\s*lights\s+$me\s+on\s+fire\s*[!1.]*\s*$/si) {
$self->Perform($event, 'veryow');
} elsif ($message =~ /^\s*(?:pats|strokes|pets)\s+$me\s*[!1.]*\s*$/si) {
$self->Perform($event, 'happy');
} elsif ($message =~ /^\s*slaps\s+$me\s+(?:around\s+)?(?:a\s+(?:bit|lot|little|while)\s+)?with\s+a\s+(?:(?:big|fat|large|wet|and)[\s,]+)*trout\s*[!1.]*\s*$/si) {
$self->Perform($event, 'ow');
} elsif ($message =~ /^\s*(?:slaps|kicks|smacks)\s+$me\s*[!1.]*\s*$/si) {
$self->Perform($event, 'yousuck');
} elsif ($message =~ /^\s*(?:hugs|kisses)\s+$me\s*[!1.]*\s*$/si) {
$self->Perform($event, 'vhappy');
} else {
return $self->SUPER::Felt(@_);
}
return 0; # we've dealt with it, no need to do anything else.
}
sub Saw {
my $self = shift;
my ($event, $message) = @_;
if ($message =~ /^\s*r+h(e+)t+s?[!1.]*\s*$/osi) {
if ((time()-$self->{'lastrheet'}) > $self->{'rheetbuffer'}) {
$self->say($event, "rhe$1$1t!");
$self->{'lastrheet'} = time();
}
} elsif (($message =~ /^\s*(?:smiles)\s*[!1.]*\s*$/si) and ($self->canAssumeThanks($event))) {
$self->Perform($event, 'happy');
} else {
return $self->SUPER::Felt(@_);
}
return 0; # we've dealt with it, no need to do anything else.
}
# SpottedJoin - Called when someone joins a channel
sub SpottedJoin {
my $self = shift;
my ($event, $channel, $who) = @_;
return if grep(lc($_) eq $channel, @{$self->{'autoGreetMute'}});
my $user = $event->{'user'};
if ($self->canGreet($event) and $self->{'autoGreetings'}->{$who}) {
$self->sayOrEmote($event, $self->Expand($event, $self->{'autoGreetings'}->{$who}));
$self->{'autoGreeted'}->{$user} = time();
}
return 1; # don't block other modules...
}
sub GetNext {
my $self = shift;
my ($list) = @_;
$self->{"${list}Index"} = 0 if $self->{"${list}Index"} > $#{$self->{$list}};
my $reply = $self->{$list}->[$self->{"${list}Index"}++];
$self->saveConfig();
return $reply;
}
sub canGreet {
my $self = shift;
my ($event) = @_;
my $user = $event->{'user'};
my $reply = 1;
if (defined($self->{'autoGreeted'}->{$user})) {
$reply = ((time() - $self->{'autoGreeted'}->{$user}) > $self->{'autoGreetedBackoffTime'});
delete($self->{'autoGreeted'}->{$user});
}
return $reply;
}
sub canAssumeThanks {
my $self = shift;
my ($event) = @_;
my $who = $event->{'user'};
return ((defined($self->{'_lastSpoken'}->{$who})) and ((time() - $self->{'_lastSpoken'}->{$who}) <= $self->{'assumeThanksTime'}));
}
sub Perform {
my $self = shift;
my ($event, $list) = @_;
$self->sayOrEmote($event, $self->Expand($event, $self->GetNext($list)));
}
# replaces '%' with the target nick (XXX cannot escape a "%"!!!)
sub Expand {
my $self = shift;
my ($event, $data) = @_;
$data =~ s/%/$event->{'from'}/gos;
return $data;
}

29
webtools/mozbot/BotModules/HelloWorld.bm Normal file
View File

@ -0,0 +1,29 @@
################################
# Hello World Module #
################################
package BotModules::HelloWorld;
use vars qw(@ISA);
@ISA = qw(BotModules);
1;
sub Help {
my $self = shift;
my ($event) = @_;
return {
'' => 'This is the demo module that says Hello World.',
'hi' => 'Requests that the bot emit a hello world string.',
};
}
sub Told {
my $self = shift;
my ($event, $message) = @_;
if ($message =~ /^\s*hi\s*$/osi) {
$self->say($event, 'Hello World!');
} else {
return $self->SUPER::Told(@_);
}
return 0; # we've dealt with it, no need to do anything else.
}

51
webtools/mozbot/BotModules/KeepAlive.bm Normal file
View File

@ -0,0 +1,51 @@
################################
# KeepAlive Module #
################################
package BotModules::KeepAlive;
use vars qw(@ISA);
@ISA = qw(BotModules);
1;
# RegisterConfig - Called when initialised, should call registerVariables
sub RegisterConfig {
my $self = shift;
$self->SUPER::RegisterConfig(@_);
$self->registerVariables(
# [ name, save?, settable? ]
['delay', 1, 1, 20],
['string', 1, 1, 'ping'],
['target', 1, 1, '#spam'],
);
}
# Schedule - called when bot connects to a server, to install any schedulers
# use $self->schedule($event, $delay, $times, $data)
# where $times is 1 for a single event, -1 for recurring events,
# and a +ve number for an event that occurs that many times.
sub Schedule {
my $self = shift;
my ($event) = @_;
$self->schedule($event, \$self->{'delay'}, -1, 'keepalive');
$self->SUPER::Schedule($event);
}
sub Help {
my $self = shift;
my ($event) = @_;
return {
'' => 'This is a simple keep-alive module, it regularly sends text out. This has been known to help with network lag.',
} if $self->isAdmin($event);
return {};
}
sub Scheduled {
my $self = shift;
my ($event, @data) = @_;
if ($data[0] eq 'keepalive') {
local $event->{'target'} = $self->{'target'};
$self->say($event, $self->{'string'});
} else {
$self->SUPER::Scheduled($event, @data);
}
}

150
webtools/mozbot/BotModules/MiniLogger.bm Normal file
View File

@ -0,0 +1,150 @@
################################
# MiniLogger Module #
################################
package BotModules::MiniLogger;
use vars qw(@ISA);
@ISA = qw(BotModules);
1;
sub Help {
my $self = shift;
my ($event) = @_;
my %help = (
'' => 'This module keeps a log of the last few comments that match some patterns. For example, it can be used to remember URIs that have recently been mentioned.',
);
foreach (keys %{$self->{'patterns'}}) {
$help{$_} = 'Returns any recent comment that matched the pattern /'.$self->sanitizeRegexp($self->{'patterns'}->{$_})."/. To narrow the search down even more, you can include a search string after the $_, as in '$_ goats'. To restrict the search to a particular channel, append \'in <channel>\' at the end.";
}
if ($self->isAdmin($event)) {
$help{''} .= ' To add a new pattern, use the following syntax: vars MiniLogger patterns \'+|name|pattern\'';
$help{'flush'} = 'Deletes any logs for patterns or channels that are no longer relevant, makes sure all the logs are no longer than the \'bufferSize\' length. Syntax: \'flush minilogs\'.';
}
return \%help;
}
# RegisterConfig - Called when initialised, should call registerVariables
sub RegisterConfig {
my $self = shift;
$self->SUPER::RegisterConfig(@_);
$self->registerVariables(
# [ name, save?, settable? ]
['log', 0, 0, {}], # log -> channel -> patternName -> [<who> text]
['bufferSize', 1, 1, 20], # number of comments to remember, per channel/pattern combination
['patterns', 1, 1, {'uris'=>'<?(:?[Uu][Rr][LlIi]:)?\s*(?:https?|ftp)://[^\s>"]+>?'}], # list of patternNames and patterns (regexp)
['blockedPatterns', 1, 1, []], # list of patterns (regexp) to ignore
);
}
sub Told {
my $self = shift;
my ($event, $message) = @_;
if (($message =~ /^\s*([a-zA-Z0-9]+)(?:\s+(.+?))?(?:\s+in\s+(.+?))?\s*$/osi) and ($self->{'patterns'}->{$1})) {
$self->Report($event, $3, $1, $2); # event, channel, log, pattern
} elsif ($self->isAdmin($event)) {
if ($message =~ /^\s*flush\s+minilogs\s*$/osi) {
$self->FlushMinilogs($event);
} else {
return $self->SUPER::Told(@_);
}
} else {
return $self->SUPER::Told(@_);
}
return 0; # we've dealt with it, no need to do anything else.
}
sub Log {
my $self = shift;
my ($event) = @_;
if (($event->{'firsttype'} eq 'Told') or ($event->{'firsttype'} eq 'Heard')) {
$self->DoLog($event, "<$event->{'from'}> $event->{'data'}");
} elsif (($event->{'firsttype'} eq 'Felt') or ($event->{'firsttype'} eq 'Saw')) {
$self->DoLog($event, "* $event->{'from'} $event->{'data'}");
}
}
sub DoLog {
my $self = shift;
my ($event, $message) = @_;
foreach my $pattern (keys %{$self->{'patterns'}}) {
my $regexp = $self->sanitizeRegexp($self->{'patterns'}->{$pattern});
if ($message =~ /$regexp/s) {
# wohay, we have a candidate!
# now check for possible blockers...
unless ($self->isBlocked($message)) {
$self->debug("LOGGING: $message");
push(@{$self->{'log'}->{$event->{'channel'}}->{$pattern}}, $message);
shift(@{$self->{'log'}->{$event->{'channel'}}->{$pattern}}) if (@{$self->{'log'}->{$event->{'channel'}}->{$pattern}} > $self->{'bufferSize'});
}
}
}
}
sub isBlocked {
my $self = shift;
my ($message) = @_;
foreach my $blockedPattern (@{$self->{'blockedPatterns'}}) {
my $regexp = $self->sanitizeRegexp($blockedPattern);
if ($message =~ /$regexp/s) {
return 1;
}
}
return 0;
}
sub Report {
my $self = shift;
my ($event, $channel, $log, $pattern) = @_;
my @channels = $channel ? lc($channel) : @{$self->{'channels'}};
my $count;
$pattern = $self->sanitizeRegexp($pattern);
foreach $channel (@channels) {
foreach my $match (@{$self->{'log'}->{$channel}->{$log}}) {
if ((!$pattern) or ($match =~ /$pattern/s)) {
$self->directSay($event, $match);
$count++;
}
}
}
unless ($count) {
$self->directSay($event, 'No matches, sorry.');
}
$self->channelSay($event, "$event->{'from'}: minilog matches /msg'ed");
}
sub FlushMinilogs {
my $self = shift;
my ($event) = @_;
# remove dead channels
my %channels = map { lc($_) => 1 } @{$self->{'channels'}};
foreach my $channel (keys %{$self->{'log'}}) {
if ($channels{$channel}) {
# remove dead logs
foreach my $pattern (keys %{$self->{'log'}->{$channel}}) {
if ($self->{'patterns'}) {
# remove any newly blocked patterns
my @newpatterns;
foreach my $match (@{$self->{'log'}->{$channel}->{$pattern}}) {
unless ($self->isBlocked($match)) {
push (@newpatterns, $match);
}
}
# remove excess logs
if (@newpatterns) {
@{$self->{'log'}->{$channel}->{$pattern}} = (@newpatterns[
@newpatterns - $self->{'bufferSize'} < 0 ? 0 : @newpatterns - $self->{'bufferSize'},
$#newpatterns]
);
} else {
@{$self->{'log'}->{$channel}->{$pattern}} = ();
}
} else {
delete($self->{'log'}->{$channel}->{$pattern});
}
}
} else {
delete($self->{'log'}->{$channel});
}
}
$self->say($event, 'Minilogs flushed.');
}

62
webtools/mozbot/BotModules/Parrot.bm Normal file
View File

@ -0,0 +1,62 @@
################################
# Parrot Module #
################################
package BotModules::Parrot;
use vars qw(@ISA);
@ISA = qw(BotModules);
1;
sub Help {
my $self = shift;
my ($event) = @_;
if ($self->isAdmin($event)) {
return {
'' => 'This module allows you to make the bot do stuff.',
'say' => 'Makes the bot say something. The <target> can be a person or channel. Syntax: say <target> <text>',
'do' => 'Makes the bot do (/me) something. The <target> can be a person or channel. Syntax: do <target> <text>',
'invite' => 'Makes the bot invite (/invite) somebody to a channel. Syntax: invite <who> <channel>',
'announce' => 'Makes the bot announce something to every channel in which this module is enabled. Syntax: announce <text>',
};
} else {
return $self->SUPER::Help($event);
}
}
sub Told {
my $self = shift;
my ($event, $message) = @_;
if ((($event->{'level'} == 1) and ($self->isAdmin($event))) or
(($event->{'level'} == 3) and ($event->{'God_channel_rights'}) and ($event->{'Parrot_channel'} eq $event->{'God_channel'}))) {
if ($message =~ /^\s*say\s+(\S+)\s+(.*)$/osi) {
local $event->{'target'} = $1;
$self->say($event, $2);
} elsif ($message =~ /^\s*do\s+(\S+)\s+(.*)$/osi) {
local $event->{'target'} = $1;
$self->emote($event, $2);
} elsif ($message =~ /^\s*announce\s+(.*)$/osi) {
$self->announce($event, $1);
} elsif ($message =~ /^\s*invite\s+(\S+)\s+(\S+)\s*$/osi) {
$self->invite($event, $1, $2);
} else {
return $self->SUPER::Told(@_);
}
} else {
if (($event->{'level'} == 1) and (($message =~ /^\s*say\s+(\S+)\s+(.*)$/osi) or ($message =~ /^\s*do\s+(\S+)\s+(.*)$/osi))) {
$event->{'God_channel'} = lc($1);
$event->{'Parrot_channel'} = lc($1);
}
my $result = $self->SUPER::Told(@_);
return $result < (3 * defined($event->{'Parrot_channel'})) ? 3 : $result;
# Note: We go through some contortions here because if the parent
# returns 3 or more, some other module sets God_channel, and
# the command is either not 'say' or 'do' (or the God_channel happens
# to be different to the channel we are looking at) then it is theoretically
# possible that God_channel_rights could be set, but not for the channel
# we care about. Or something..... ;-)
}
return 0; # we've dealt with it, no need to do anything else.
}

255
webtools/mozbot/BotModules/RDF.bm Normal file
View File

@ -0,0 +1,255 @@
################################
# RDF Module #
################################
package BotModules::RDF;
use vars qw(@ISA);
@ISA = qw(BotModules);
1;
# RegisterConfig - Called when initialised, should call registerVariables
sub RegisterConfig {
my $self = shift;
$self->SUPER::RegisterConfig(@_);
$self->registerVariables(
# [ name, save?, settable? ]
['sites', 1, 1, {}],
['updateDelay', 1, 1, 600],
['preferredLineLength', 1, 1, 80],
['maxInChannel', 1, 1, 5],
['trimTitles', 1, 1, '0'],
['data', 0, 0, {}], # data -> uri -> (title, link, last, items -> uri)
['mutes', 1, 1, {}], # uri -> "channel channel channel"
);
}
# Schedule - called when bot connects to a server, to install any schedulers
# use $self->schedule($event, $delay, $times, $data)
# where $times is 1 for a single event, -1 for recurring events,
# and a +ve number for an event that occurs that many times.
sub Schedule {
my $self = shift;
my ($event) = @_;
$self->schedule($event, \$self->{'updateDelay'}, -1, 'rdf');
$self->SUPER::Schedule($event);
}
sub Help {
my $self = shift;
my ($event) = @_;
my %commands;
if ($self->isAdmin($event)) {
$commands{''} = "The RDF module monitors various websites. Add new RDF channels to the 'sites' hash. Duplicates with different nicknames are fine. For example, \"vars $self->{'_name'} sites '+|slashdot|http://...'\" and \"vars $self->{'_name'} sites '+|/.|http://...'\" is fine.";
$commands{'mute'} = 'Disable reporting of a site in a channel. (Only does something if the given site exists.) Syntax: mute <site> in <channel>';
$commands{'unmute'} = 'Enable reporting of a site in a channel. By default, sites are reported in all channels that the module is active in. Syntax: unmute <site> in <channel>';
} else {
$commands{''} = 'The RDF module monitors various websites.';
}
foreach my $site (keys(%{$self->{'sites'}})) {
if ($self->{'data'}->{$self->{'sites'}->{$site}}) {
$commands{$site} = "Reports the headlines listed in $self->{'data'}->{$self->{'sites'}->{$site}}->{'title'}";
# -- #mozilla was here --
# <Hixie> anyway, $self->{'data'}->{$self->{'sites'}->{$site}}->{'title'} is
# another nice piece of perl (embedded in a quoted string in this case)
# <moogle> yeah, that's a bit more familiar
# <jag> Oooh, nice one
# <jag> Reminds me of Java, a bit :-)
# <jag> Without all the casting about from Object to Hashtable
# <Hixie> all this, BTW, is from the RDF module (the one that mozbot uses to
# report changes in mozillazine and so on)
# <moogle> I still tend to comment these things a bit just for maintainability
# by others who might not wish to do mental gymnastics :)
# <Hixie> :-)
} else {
$commands{$site} = "Reports the headlines listed in $self->{'sites'}->{$site}";
}
}
return \%commands;
}
sub Told {
my $self = shift;
my ($event, $message) = @_;
foreach my $site (keys(%{$self->{'sites'}})) {
if ($message =~ /^\s*(\Q$site\E)\s*$/si) {
$self->GetSite($event, $1, 'request');
return 0; # dealt with it...
}
}
if ($self->isAdmin($event)) {
if ($message =~ /^\s*mute\s+(\S+?)\s+in\s+(\S+?)\s*$/osi) {
my $site = $1 eq 'RDF' ? '' : $self->{'sites'}->{$1};
my $siteName = $site eq '' ? 'all sites' : $site;
if (defined($site)) {
$self->{'mutes'}->{$site} .= " $2";
$self->saveConfig();
$self->say($event, "$event->{'from'}: RDF notifications for $siteName muted in channel $2.");
} else {
# can't say this, other modules might recognise it: $self->say($event, "$event->{'from'}: I don't know about any '$1' site...");
}
} elsif ($message =~ /^\s*unmute\s+(\S+?)\s+in\s+(\S+?)\s*$/osi) {
my $site = $1 eq 'RDF' ? '' : $self->{'sites'}->{$1};
my $siteName = $site eq '' ? 'all sites' : $site;
if (defined($site)) {
my %mutedChannels = map { lc($_) => 1 } split(/ /o, $self->{'mutes'}->{$site});
delete($mutedChannels{lc($2)}); # get rid of any mentions of that channel
$self->{'mutes'}->{$site} = join(' ', keys(%mutedChannels));
$self->saveConfig();
$self->say($event, "$event->{'from'}: RDF notifications for $siteName resumed in channel $2.");
} else {
# can't say this, other modules might recognise it: $self->say($event, "$event->{'from'}: I don't know about any '$1' site...");
}
} else {
return $self->SUPER::Told(@_);
}
} else {
return $self->SUPER::Told(@_);
}
return 0;
}
sub GetSite {
my $self = shift;
my ($event, $site, $intent) = @_;
if (defined($self->{'sites'}->{$site})) {
my $uri = $self->{'sites'}->{$site};
$self->getURI($event, $uri, $intent);
} else {
# XXX
}
}
sub GotURI {
my $self = shift;
my ($event, $uri, $output, $intent) = @_;
$self->{'data'}->{$uri}->{'ready'} = defined($self->{'data'}->{$uri});
if ($output) {
# last update stamp
$self->{'data'}->{$uri}->{'last'} = time();
# this, of course, is a disaster waiting to happen.
# for example, we don't cope with comments.
# someone write a real XML version of this pleeeeease... XXX
# get the juicy stuff out
my $channelpart = "";
if ($output =~ /<channel>(.*)<\/channel>/osi) {
$channelpart = $1;
}
# remove any image related stuff
$output =~ s/<image>.*<\/image>//gosi;
# get the channel title
$self->{'data'}->{$uri}->{'title'} = $uri;
if ($channelpart =~ /<title>\s*(.+?)\s*<\/title>/osi) {
$self->{'data'}->{$uri}->{'title'} = $self->unescapeXML($1);
$self->{'data'}->{$uri}->{'title'} =~ s/: News for nerds, stuff that matters//gosi if $self->{'trimTitles'};
}
# get the channel website
$self->{'data'}->{$uri}->{'link'} = $uri;
if ($channelpart =~ /<link>\s*(.+?)\s*<\/link>/osi) {
$self->{'data'}->{$uri}->{'link'} = $self->unescapeXML($1);
}
# get all the items
while ($output =~ /<item>.*?<title>\s*(.+?)\s*<\/title>.*?<\/item>/osig) {
unless (($1 =~ /^last update/osi) or (defined($self->{'data'}->{$uri}->{'items'}->{$self->unescapeXML($1)}))) {
$self->{'data'}->{$uri}->{'items'}->{$self->unescapeXML($1)} = $self->{'data'}->{$uri}->{'last'};
}
}
$self->ReportDiffs($event, $uri, $intent);
if ($intent eq 'request') {
$self->ReportAll($event, $uri);
}
} else {
if ($intent eq 'request') {
$self->say($event, "$event->{'from'}: Dude, the file was empty! ($uri)");
}
}
}
sub Scheduled {
my $self = shift;
my ($event, @data) = @_;
if ($data[0] eq 'rdf') {
my %sites = map { $_ => 1 } values(%{$self->{'sites'}});
foreach (keys(%sites)) {
$self->getURI($event, $_, 'update');
}
} else {
$self->SUPER::Scheduled($event, @data);
}
}
sub ReportDiffs {
my $self = shift;
my ($event, $uri, $request) = @_;
return unless $self->{'data'}->{$uri}->{'ready'};
my $last = $self->{'data'}->{$uri}->{'last'};
my @output;
foreach (keys(%{$self->{'data'}->{$uri}->{'items'}})) {
push(@output, $_) if ($self->{'data'}->{$uri}->{'items'}->{$_} == $last);
}
if (@output) {
@output = $self->prettyPrint($self->{'preferredLineLength'},
"Just appeared in $self->{'data'}->{$uri}->{'title'} - $self->{'data'}->{$uri}->{'link'} : ",
'', ' -- ', @output);
my %mutedChannels = ();
if (defined($self->{'mutes'}->{$uri})) {
%mutedChannels = map { lc($_) => 1 } split(/\s+/os, $self->{'mutes'}->{$uri});
}
if (defined($self->{'mutes'}->{''})) {
%mutedChannels = (%mutedChannels, map { lc($_) => 1 } split(/\s+/os, $self->{'mutes'}->{''}));
}
if ($request eq 'request') {
$mutedChannels{$event->{'channel'}} = 1;
}
foreach (@{$self->{'channels'}}) {
unless ($mutedChannels{$_}) {
local $event->{'target'} = $_;
foreach (@output) {
$self->say($event, $_);
}
}
}
}
}
sub ReportAll {
my $self = shift;
my ($event, $uri) = @_;
my @output;
foreach (keys(%{$self->{'data'}->{$uri}->{'items'}})) {
push(@output, $_);
}
@output = $self->prettyPrint($self->{'preferredLineLength'},
"Items in $self->{'data'}->{$uri}->{'title'} - $self->{'data'}->{$uri}->{'link'}: ",
"$event->{'from'}: ", ' -- ', @output);
if (@output > $self->{'maxInChannel'}) {
foreach (@output) {
$self->directSay($event, $_);
}
$self->channelSay($event, "$event->{'from'}: /msg'ed");
} else {
foreach (@output) {
$self->say($event, $_);
}
}
}

83
webtools/mozbot/BotModules/Rude.bm Normal file
View File

@ -0,0 +1,83 @@
################################
# Rude Module #
################################
package BotModules::Rude;
use vars qw(@ISA);
use Net::Telnet;
@ISA = qw(BotModules);
1;
sub Help {
my $self = shift;
my ($event) = @_;
return {
'' => 'The Rude Module is... rude. Very rude! So rude!!!',
'insult' => 'Insults someone. Syntax: \'insult <who>\'',
'excuse' => 'Gives you an excuse for the system being down. Syntax: \'excuse\'',
};
}
# -- timeless was here --
# <timeless> Rude module is missing a jar jar quote ~how wude~
# RegisterConfig - Called when initialised, should call registerVariables
sub RegisterConfig {
my $self = shift;
$self->SUPER::RegisterConfig(@_);
$self->registerVariables(
# [ name, save?, settable? ]
['insultHost', 1, 1, 'insulthost.colorado.edu'],
['insultPort', 1, 1, '1695'],
['excuseHost', 1, 1, 'bofh.engr.wisc.edu'], # or bofh.jive.org
['excusePort', 1, 1, '666'],
['insultOverrides', 1, 1, { # overrides for the insults (keys must be lowercase)
'mozilla' => 'You are nothing but the best browser on the planet.',
'mozilla.org' => 'You are nothing but the best caretaker Mozilla ever had.',
'c++' => 'you are evil',
}],
);
}
sub Told {
my $self = shift;
my ($event, $message) = @_;
if ($message =~ /^\s*insult\s+(\S+?)\s*$/osi) {
my $line;
if (defined($self->{'insultOverrides'}->{lc $1})) {
$line = "$1: ".$self->{'insultOverrides'}->{lc $1};
} else {
my $t = new Net::Telnet (Timeout => 3);
$t->Net::Telnet::open(Host => $self->{'insultHost'}, Port => $self->{'insultPort'});
$line = "$1: ".$t->Net::Telnet::getline(Timeout => 4);
}
if ($line) {
$self->say($event, $line);
} else {
$self->say($event, "$event->{'from'}: What have they ever done to you! Leave 'em alone!");
$self->debug("yikes, $self->{'insultHost'}:$self->{'insultPort'} is down!");
}
} elsif ($message =~ /^\s*(?:please\s+)?(?:can\s+i\s+have\s+an\s+|(?:(?:can|could)\s+you\s+)?give\s+me\s+an\s+)?excuse(?:[?,.!1\s]+please)?\s*[!?,.1]*\s*$/osi) {
my $t = new Net::Telnet (Timeout => 3);
$t->Net::Telnet::open(Host => $self->{'excuseHost'}, Port => $self->{'excusePort'});
# print "=== The BOFH-style Excuse Server --- Feel The Power!\n";
$t->Net::Telnet::getline(Timeout => 4);
# print "=== By Jeff Ballard <ballard\@cs.wisc.edu>\n";
$t->Net::Telnet::getline(Timeout => 4);
# print "=== See http://www.cs.wisc.edu/~ballard/bofh/ for more info.\n";
$t->Net::Telnet::getline(Timeout => 4);
# print "Your excuse is: $excuses[$j]";
my $line = $t->Net::Telnet::getline(Timeout => 4);
if ($line) {
# $line =~ s/^.*?Your excuse is: //gosi;
# $self->say($event, "$event->{'from'}: '$line'");
$self->say($event, "$line");
} else {
$self->say($event, "$event->{'from'}: Don't ask *me* for an excuse! Sheesh!");
$self->debug("yikes, $self->{'insultHost'}:$self->{'insultPort'} is down!");
}
} else {
return $self->SUPER::Told(@_);
}
return 0; # we've dealt with it, no need to do anything else.
}

139
webtools/mozbot/BotModules/Sheriff.bm Normal file
View File

@ -0,0 +1,139 @@
################################
# Sheriff Module #
################################
package BotModules::Sheriff;
use vars qw(@ISA);
@ISA = qw(BotModules);
1;
# RegisterConfig - Called when initialised, should call registerVariables
sub RegisterConfig {
my $self = shift;
$self->SUPER::RegisterConfig(@_);
$self->registerVariables(
# [ name, save?, settable? ]
['tree', 1, 1, 'SeaMonkey'],
['baseURI', 1, 1, 'http://tinderbox.mozilla.org/'],
['_sheriff', 1, 0, undef], # the undef actually means "don't touch", of course
['updateDelay', 1, 1, 360],
# XXX implement per-channel muting of the update notification
);
}
# Schedule - called when bot connects to a server, to install any schedulers
# use $self->schedule($event, $delay, $times, $data)
# where $times is 1 for a single event, -1 for recurring events,
# and a +ve number for an event that occurs that many times.
sub Schedule {
my $self = shift;
my ($event) = @_;
$self->schedule($event, \$self->{'updateDelay'}, -1, 'sheriff');
$self->SUPER::Schedule($event);
}
sub Help {
my $self = shift;
my ($event) = @_;
return {
'' => 'The Sheriff module keeps track of the current sheriff.',
'sheriff' => 'Display the current sheriff. Syntax: sheriff [tree]',
};
}
sub Told {
my $self = shift;
my ($event, $message) = @_;
if ($message =~ /^\s*(?:who's\s+|whose\s+|whos\s+|who\s+is\s+the\s+|who\s+is\s+|who\s+)?sheriff(?:\s+(?:of\s+)?(.*?))?(?:[\s,]+today)?[.?!1]*\s*$/osi) {
$self->GetSheriff($event, $1 || $self->{'tree'}, 'requested');
} else {
return $self->SUPER::Told(@_);
}
return 0; # dealt with it...
}
sub GetSheriff {
my $self = shift;
my ($event, $tree, $requested) = @_;
my $url = "$self->{'baseURI'}$tree/sheriff.pl";
$self->getURI($event, $url, $tree, $requested);
}
sub GotURI {
my $self = shift;
my ($event, $uri, $output, $tree, $requested) = @_;
# someone please pretty up the logic here... XXX
if ($output) {
# magicness
{ no warnings; # this can go _very_ wrong easily
# sheriff.pl is created using the following lines:
# $m =~ s/\'/\\\'/g;
# print SHERIFF "\$current_sheriff = '$m';\n1;";
$output =~ s/^\$current_sheriff = '//gosi; # strip front
$output =~ s/';\n1;$//gosi; # strip back
$output =~ s/\\\'/\'/gosi; # dequote quotes
# heuristics
$output =~ s/\n|\r|<a\s+href="|<\/a>//gosi;
$output =~ s/">/, /gosi;
$output =~ s/<br>/ /gosi;
$output =~ s/<\/?(?:b|strong)>/*/gosi;
$output =~ s/<\/?(?:u|em)>/_/gosi;
$output =~ s/<\/?(?:q)>/"/gosi;
$output =~ s/<\/?(?:i|dfn|cite)>/\//gosi;
}
if (defined($output)) {
if ($tree eq $self->{'tree'}) {
if ((defined($self->{'_sheriff'})) and ($self->{'_sheriff'} ne '')) { # not first time
if ($output ne $self->{'_sheriff'}) { # changed.
$self->announce($event, "Sheriff change: $output");
if (($requested) and (not ($event->{'channel'}))) {
$self->directSay($event, "$output");
}
} elsif ($requested) {
$self->say($event, "$event->{'from'}: $output");
}
} else { # first time
$self->say($event, "$event->{'from'}: $output") if ($requested);
}
$self->{'_sheriff'} = $output; # update internal cache
} else { # not default tree
if ($requested) {
$self->say($event, "$event->{'from'}: $output");
} # else EH!?
}
} else {
# something went very wrong
$self->say($event, "$event->{'from'}: I have no idea -- the '$tree' tree probably doesn't have a sheriff.") if ($requested);
if ($tree eq $self->{'tree'}) {
if (defined($self->{'_sheriff'})) {
# only do it once
$self->tellAdmin($event, "Oh dear lord what happened to the '$tree' sheriff line on the tinderbox page!!");
$self->{'_sheriff'} = undef;
}
}
}
} else {
if ($tree eq $self->{'tree'}) {
$self->say($event, "$event->{'from'}: Call an admin, I couldn't find the Sheriff page. Sorry!") if ($requested);
if (defined($self->{'_sheriff'})) {
# only do it once
$self->tellAdmin($event, "Looks like either I am badly configured or tinderbox is down - '$tree' came up blank when I went looking for the Sheriff.");
$self->{'_sheriff'} = undef;
}
} else {
if ($requested) {
$self->say($event, "$event->{'from'}: Are you sure there is a tree called '$tree'? I couldn't find one...");
} # else EH!?
}
}
}
sub Scheduled {
my $self = shift;
my ($event, @data) = @_;
if ($data[0] eq 'sheriff') {
$self->GetSheriff($event, $self->{'tree'}, 0);
} else {
$self->SUPER::Scheduled($event, @data);
}
}

463
webtools/mozbot/BotModules/Tinderbox.bm Normal file
View File

@ -0,0 +1,463 @@
################################
# Tinderbox Module #
################################
package BotModules::Tinderbox;
use vars qw(@ISA);
@ISA = qw(BotModules);
1;
# RegisterConfig - Called when initialised, should call registerVariables
sub RegisterConfig {
my $self = shift;
$self->SUPER::RegisterConfig(@_);
$self->registerVariables(
# [ name, save?, settable? ]
['trees', 1, 1, ['SeaMonkey', 'SeaMonkey-Ports', 'MozillaTest', 'Grendel']],
['treesAnnounced', 1, 1, ['SeaMonkey', 'SeaMonkey-Ports']],
['treesDefault', 1, 1, ['SeaMonkey']],
['treeStates', 0, 0, {}], # ->tree->(current, previous, lastupdate)
['lasttreesStates', 0, 0, []], # copy of trees in last test
['tinderboxStates', 0, 0, {}], # ->tree->build->(current, previous, lastupdate)
['updateDelay', 1, 1, 120],
['_lastupdate', 0, 0, 0],
['preferredLineLength', 1, 1, 100],
['mutes', 1, 1, {}], # tree -> "channel channel channel"
['states', 1, 1, {'success' => 'Success', 'testfailed' => 'Test Failed', 'busted' => 'Burning', }],
['maxInChannel', 1, 1, 5], # maximum number of lines to report in a channel
);
}
# Schedule - called when bot connects to a server, to install any schedulers
# use $self->schedule($event, $delay, $times, $data)
# where $times is 1 for a single event, -1 for recurring events,
# and a +ve number for an event that occurs that many times.
sub Schedule {
my $self = shift;
my ($event) = @_;
$self->schedule($event, \$self->{'updateDelay'}, -1, 'tinderbox');
$self->SUPER::Schedule($event);
}
sub Help {
my $self = shift;
my ($event) = @_;
my %commands = (
'' => 'The Tinderbox module monitors who the state of the tinderboxen.',
'qt' => 'Quick trees, same as \'trees terse\'. You can give it a <tree> argument if you like, for example \'qt seamonkey\'.',
'builds' => 'Gives the status of all the builds in all the trees that match a particular pattern. Syntax: \'builds <build>\'. For example: \'builds Mac\'.',
'trees' => 'Reports on the current state of the tinderboxen. Syntax: \'trees <options> <tree>\' where <options> is any number of: '.
'all (show all trees and all builds), main (show only main trees), burning (show only burning builds), '.
'long, medium, short, terse (how much detail to include), and <tree> is the name of the tree to show (or a regexp matching it).',
);
if ($self->isAdmin($event)) {
$commands{'mute'} = 'Disable reporting of a tree in a channel. (Only does something if the given tree exists.) Syntax: mute <tree> in <channel>';
$commands{'unmute'} = 'Enable reporting of a tree in a channel. By default, trees are reported in all channels that the module is active in. Syntax: unmute <tree> in <channel>';
}
return \%commands;
}
sub Told {
my $self = shift;
my ($event, $message) = @_;
if ($message =~ /^\s*trees?(?:\s+(.*?))?\s*(?:[, ]\s*please)?\?*\s*$/osi) {
# initial setup
my $trees = -1; # 0=default; 1=all; 'x'=pattern match
my $builds = -1; # 0=all; 1=horked and test failed; 2=horked only
my $verbosity = -1; # 1=terse; 2; 3; 4=verbose
# parse parameters
if (defined($1)) {
foreach (split(/\s+/, $1)) {
if (/^all$/osi) { $trees = '1' if $trees < 0; $builds = 0 if $builds < 0; }
elsif (/^main$/osi) { $trees = '0'; }
elsif (/^burning$/osi) { $builds = 2; }
elsif (/^long$/osi) { $verbosity = 4; }
elsif (/^medium$/osi) { $verbosity = 3; }
elsif (/^short$/osi) { $verbosity = 2; }
elsif (/^terse$/osi) { $verbosity = 1; }
else { $trees = $_; }
}
}
# defaults
$trees = '0' if $trees < 0;
$builds = 1 if $builds < 0;
$verbosity = 2 if $verbosity < 0;
# go
$self->GetTrees($event, 1, $trees, $builds, $verbosity);
} elsif ($message =~ /^\s*builds?\s+(.*?)\s*\?*\s*$/osi) {
$self->GetTrees($event, 2, $1);
} elsif ($message =~ /^\s*qt(?:\s+(.+?))?\s*$/osi) {
$self->GetTrees($event, 1, defined($1) ? $1 : 0, 1, 1);
} elsif ($self->isAdmin($event)) {
if ($message =~ /^\s*mute\s+(\S+?)\s+in\s+(\S+?)\s*$/osi) {
my $tree = $1 eq 'Tinderbox' ? '' : $1;
my $treeName = $tree eq '' ? 'all trees' : "trees named $tree";
if (($tree eq '') or (grep($_ eq $tree, @{$self->{'trees'}}))) {
$self->{'mutes'}->{$tree} .= " $2";
$self->saveConfig();
$self->say($event, "$event->{'from'}: Tinderbox notifications for $treeName muted in channel $2.");
} else {
$self->say($event, "$event->{'from'}: There is no tree called $tree is there?.");
}
} elsif ($message =~ /^\s*unmute\s+(\S+?)\s+in\s+(\S+?)\s*$/osi) {
my $tree = $1 eq 'Tinderbox' ? '' : $1;
my $treeName = $tree eq '' ? 'all trees' : "trees named $tree";
if (($tree eq '') or (grep($_ eq $tree, @{$self->{'trees'}}))) {
my %mutedChannels = map { lc($_) => 1 } split(/ /o, $self->{'mutes'}->{$1});
delete($mutedChannels{lc($2)}); # get rid of any mentions of that channel
$self->{'mutes'}->{$1} = join(' ', keys(%mutedChannels));
$self->saveConfig();
$self->say($event, "$event->{'from'}: Tinderbox notifications for trees named $1 resumed in channel $2.");
} else {
$self->say($event, "$event->{'from'}: There is no tree called $tree is there?.");
}
} else {
return $self->SUPER::Told(@_);
}
} else {
return $self->SUPER::Told(@_);
}
return 0; # dealt with it...
}
sub GetTrees {
my $self = shift;
my ($event, $requested, @mode) = @_;
my @trees = @{$self->{'trees'}};
local $" = ','; # XXX %-escape this
my $uri = "http://tinderbox.mozilla.org/showbuilds.cgi?quickparse=1&tree=@trees";
$self->getURI($event, $uri, $requested, @mode);
}
sub GotURI {
my $self = shift;
my ($event, $uri, $output, $requested, @mode) = @_;
if ($output) {
my $now = time();
$self->{'_lastupdate'} = $now;
my @lines = split(/\n/os, $output);
# NOTE. There is a box in Tinderbox whereby if you pass it an invalid tree name, it
# will stop at that tree and not give you any others. It won't give you an error
# message, either. So do not give it the wrong trees!!! (XXX should fix this)
# loop through quickparse output
foreach my $line (@lines) {
my ($type, $tree, $build, $state) = split(/\|/os, $line);
if ($type eq 'State') {
$self->{'treeStates'}->{$tree}->{'lastupdate'} = $now;
if (defined($self->{'treeStates'}->{$tree}->{'current'})) {
$self->{'treeStates'}->{$tree}->{'previous'} = $self->{'treeStates'}->{$tree}->{'current'};
}
$self->{'treeStates'}->{$tree}->{'current'} = $state;
$self->{'states'}->{$state} = $state unless defined($self->{'states'}->{$state});
} elsif ($type eq 'Build') {
$self->{'tinderboxStates'}->{$tree}->{$build}->{'lastupdate'} = $now;
if (defined($self->{'tinderboxStates'}->{$tree}->{$build}->{'current'})) {
$self->{'tinderboxStates'}->{$tree}->{$build}->{'previous'} = $self->{'tinderboxStates'}->{$tree}->{$build}->{'current'};
}
$self->{'tinderboxStates'}->{$tree}->{$build}->{'current'} = $state;
$self->{'states'}->{$state} = $state unless defined($self->{'states'}->{$state});
} # else unsupported type XXX
}
$self->CheckForUpdates($event, $requested);
if ($requested == 1) {
$self->ReportState($event, @mode);
} elsif ($requested == 2) {
$self->ReportBuild($event, @mode);
}
# update list of active trees
@{$self->{'lasttreesState'}} = @{$self->{'trees'}};
} else {
if ($requested) {
$self->say($event, "$event->{'from'}: I can't access tinderbox right now, sorry.");
}
$self->debug('failed to get tinderbox data');
}
}
sub Scheduled {
my $self = shift;
my ($event, @data) = @_;
if ($data[0] eq 'tinderbox') {
$self->GetTrees($event, 0);
} else {
$self->SUPER::Scheduled($event, @data);
}
}
sub CheckForUpdates {
my $self = shift;
my ($event, $avoidTarget) = @_;
my $a; # disclaimer: I was asleep when I wrote the next line. I've no longer any idea what it does.
my @trees = map { $a = $_; grep { $_ eq $a } @{$self->{'lasttreesState'}}; } @{$self->{'treesAnnounced'}};
# After staring at it for a few minutes, I think what it does is get a list of the trees that should
# be announced, AND that have already been found to exist. But I'm not 100% sure.
foreach my $tree (@trees) {
my @newTrees;
my @newBuilds;
my @lostBuilds;
my @lostTrees;
my @changes;
# check trees
if (defined($self->{'treeStates'}->{$tree})) {
if ($self->{'treeStates'}->{$tree}->{'lastupdate'} == $self->{'_lastupdate'}) {
if (defined($self->{'treeStates'}->{$tree}->{'previous'})) {
if ($self->{'treeStates'}->{$tree}->{'previous'} ne $self->{'treeStates'}->{$tree}->{'current'}) {
push(@changes, "$tree has changed state from $self->{'states'}->{$self->{'treeStates'}->{$tree}->{'previous'}} to $self->{'states'}->{$self->{'treeStates'}->{$tree}->{'current'}}.");
}
} else {
push(@newTrees, "New tree added to tinderbox: $tree (state: $self->{'states'}->{$self->{'treeStates'}->{$tree}->{'current'}}).");
}
} else {
# tree has dissappeared!
delete($self->{'treeStates'}->{$tree});
push(@lostTrees, "Eek!!! Tree '$tree' has been removed from tinderbox!");
}
} # else tree doesn't exist
# check builds
if (defined($self->{'tinderboxStates'}->{$tree})) {
foreach my $build (keys(%{$self->{'tinderboxStates'}->{$tree}})) {
if ($self->{'tinderboxStates'}->{$tree}->{$build}->{'lastupdate'} == $self->{'_lastupdate'}) {
if (defined($self->{'tinderboxStates'}->{$tree}->{$build}->{'previous'})) {
if ($self->{'tinderboxStates'}->{$tree}->{$build}->{'previous'} ne $self->{'tinderboxStates'}->{$tree}->{$build}->{'current'}) {
push(@changes, "$tree: '$build' has changed state from $self->{'states'}->{$self->{'tinderboxStates'}->{$tree}->{$build}->{'previous'}} to $self->{'states'}->{$self->{'tinderboxStates'}->{$tree}->{$build}->{'current'}}.");
}
} else {
push(@newBuilds, "New build added to $tree: $build (status: $self->{'states'}->{$self->{'tinderboxStates'}->{$tree}->{$build}->{'current'}}).");
}
} else {
# build has dissappeared!
delete($self->{'tinderboxStates'}->{$tree}->{$build});
push(@lostBuilds, "Build '$build' has dropped from the '$tree' tinderbox.");
}
}
} # else tree doesn't exist
# sort out which channels to talk to
my %mutedChannels = ();
if (defined($self->{'mutes'}->{$tree})) {
%mutedChannels = map { lc($_) => 1 } split(/\s+/os, $self->{'mutes'}->{$tree});
}
if (defined($self->{'mutes'}->{''})) {
%mutedChannels = (%mutedChannels, map { lc($_) => 1 } split(/\s+/os, $self->{'mutes'}->{''}));
}
if (($avoidTarget) and ($event->{'target'} eq $event->{'channel'})) {
$mutedChannels{$event->{'channel'}} = 1;
}
# speak!
foreach (@{$self->{'channels'}}) {
unless ($mutedChannels{$_}) {
local $event->{'target'} = $_;
foreach (@newTrees, @lostTrees, @newBuilds, @lostBuilds, @changes) {
$self->say($event, $_);
}
}
}
}
}
sub ReportState {
my $self = shift;
my ($event, $trees, $builds, $verbosity) = @_;
# $trees: 0=default; 1=all; 'x'=pattern match
# $builds: 0=all; 1=horked and test failed; 2=horked only
# $verbosity: 1=terse; 2; 3; 4=verbose
# the complete output
my @lines;
# work out which trees we want
my @trees;
if ($trees eq '0') {
@trees = @{$self->{'treesDefault'}};
} elsif ($trees eq '1') {
@trees = @{$self->{'trees'}};
} else {
my $pattern = $self->sanitizeRegexp($trees);
foreach my $tree (keys %{$self->{'treeStates'}}) {
push(@trees, $tree) if $tree =~ /$pattern/si;
}
}
if (@trees) {
foreach my $tree (@trees) {
if ((defined($self->{'treeStates'}->{$tree})) and ($self->{'treeStates'}->{$tree}->{'lastupdate'} == $self->{'_lastupdate'})) {
# setup
my @output;
my ($redShort) = ($self->{'states'}->{'bustedShort'} or split(//osi, $self->{'states'}->{'busted'}));
my $red = 0;
my ($orangeShort) = ($self->{'states'}->{'testfailedShort'} or split(//osi, $self->{'states'}->{'testfailed'}));
my $orange = 0;
my ($greenShort) = ($self->{'states'}->{'successShort'} or split(//osi, $self->{'states'}->{'success'}));
my $green = 0;
# foreach build
if (defined($self->{'tinderboxStates'}->{$tree})) {
foreach my $build (keys(%{$self->{'tinderboxStates'}->{$tree}})) {
if ($self->{'tinderboxStates'}->{$tree}->{$build}->{'lastupdate'} == $self->{'_lastupdate'}) {
my $state = $self->{'tinderboxStates'}->{$tree}->{$build}->{'current'};
# count results
if ($state eq 'success') {
$green++;
} elsif ($state eq 'testfailed') {
$orange++;
} else {
$red++;
}
# make sure we should list this build
if ($state eq 'success') {
next if $builds >= 1;
} elsif ($state eq 'testfailed') {
next if $builds >= 2;
}
if ($verbosity == 1) {
my($minibuild) = split(/\s/osi, $build);
my $ministate = $self->{'states'}->{$state.'Short'};
if (not $ministate) {
($ministate) = split(//osi, $self->{'states'}->{$state});
}
push(@output, "$minibuild: $ministate;");
} elsif (($verbosity == 2) || ($verbosity == 3)) {
my($minibuild) = $verbosity == 2 ? split(/\s/osi, $build) : ($build);
my $ministate = $self->{'states'}->{$state.'Medium'};
if (not $ministate) {
$ministate = $self->{'states'}->{$state};
}
push(@output, "$minibuild ($ministate),");
} else {
push(@output, "[$build: $self->{'states'}->{$state}]")
}
} # else build is dead
} # (foreach build)
} # else tree is dead
# pretty print it
my @newoutput;
if ($verbosity == 1) {
if (@output == 0) {
unless ($red + $green + $orange) {
push(@output, "(none)");
} elsif ($builds <= 1) {
push(@output, "(all green)");
} else {
push(@output, "(none red)");
}
}
my $ministate = $self->{'states'}->{$self->{'treeStates'}->{$tree}->{'current'}.'Short'};
if (not $ministate) {
($ministate) = split(//osi, $self->{'states'}->{$self->{'treeStates'}->{$tree}->{'current'}});
}
@newoutput = $self->wordWrap($self->{'preferredLineLength'},
"$tree <$ministate> $redShort:${red} $orangeShort:${orange} $greenShort:${green} ",
' ', ' ', @output);
$newoutput[0] =~ s/^ //o;
$newoutput[$#newoutput] =~ s/;$//o;
push(@lines, @newoutput);
} elsif (($verbosity == 2) || ($verbosity == 3)) {
unless ($red+$orange+$green) {
push(@lines, "$tree <$self->{'states'}->{$self->{'treeStates'}->{$tree}->{'current'}}>: no tinderboxen for this tree.");
} elsif (($red) or ($orange)) {
if (@output == 0) {
# can only happen if $red is 0 and $builds is 1.
push(@output, "all tinderboxen compile");
}
my @newoutput = $self->wordWrap($self->{'preferredLineLength'},
"$tree <$self->{'states'}->{$self->{'treeStates'}->{$tree}->{'current'}}> $red red, $orange orange, $green green: ",
' ', ' ', @output);
$newoutput[0] =~ s/^ //o;
$newoutput[$#newoutput] =~ s/,$//o;
# if (length(@newoutput[$#newoutput]) < $self->{'preferredLineLength'} - 33) {
# $newoutput[$#newoutput] .= " Summary: $red red, $orange orange, $green green";
# } else {
# push(@newoutput, " Summary: $red red, $orange orange, $green green");
# }
push(@lines, @newoutput);
} else {
push(@lines, "$tree <$self->{'states'}->{$self->{'treeStates'}->{$tree}->{'current'}}>: all $green tinderboxen green!");
}
} else {
if (@output == 0) {
unless ($red + $green + $orange) {
push(@output, "no tinderboxen for this tree.");
} elsif ($builds <= 1) {
push(@output, "all tinderboxen for this tree are green!");
} else {
push(@output, "all tinderboxen for this tree compile successfully.");
}
}
@newoutput = $self->wordWrap($self->{'preferredLineLength'},
"$tree <$self->{'states'}->{$self->{'treeStates'}->{$tree}->{'current'}}> $red red, $orange orange, $green green: ",
' ', ' ', @output);
$newoutput[0] =~ s/^ //o;
push(@lines, @newoutput);
}
} # else tree is dead
} # (foreach tree)
} else { # no tree selected
@lines = ("No tree matches the pattern '$trees', sorry!");
}
$self->Report($event, 'tree status', @lines);
}
sub ReportBuild {
my $self = shift;
my ($event, $pattern) = @_;
# the complete output
my @output;
foreach my $tree (@{$self->{'trees'}}) {
if ((defined($self->{'treeStates'}->{$tree})) and
($self->{'treeStates'}->{$tree}->{'lastupdate'} == $self->{'_lastupdate'}) and
(defined($self->{'tinderboxStates'}->{$tree}))) {
foreach my $build (keys(%{$self->{'tinderboxStates'}->{$tree}})) {
if (($self->{'tinderboxStates'}->{$tree}->{$build}->{'lastupdate'} == $self->{'_lastupdate'}) and
($build =~ /\Q$pattern\E/is)) {
push(@output, "[$build: $self->{'states'}->{$self->{'tinderboxStates'}->{$tree}->{$build}->{'current'}}]")
}
}
}
}
@output = ('There are no matching builds.') unless @output;
@output = $self->prettyPrint($self->{'preferredLineLength'}, undef, "$event->{'from'}: ", ' ', @output);
$self->Report($event, 'tree status', @output);
}
sub Report {
my $self = shift;
my ($event, $what, @output) = @_;
if (scalar(@output) > $self->{'maxInChannel'}) {
foreach (@output) {
$self->directSay($event, $_);
}
$self->channelSay($event, "$event->{'from'}: $what /msg'ed");
} else {
foreach (@output) {
$self->say($event, $_);
}
}
}

139
webtools/mozbot/BotModules/Translate.bm Normal file
View File

@ -0,0 +1,139 @@
################################
# Translate Module #
################################
package BotModules::Translate;
use vars qw(@ISA);
use WWW::Babelfish;
# Ah, the previous line looks so innocent. Yet it hides horrible
# evil. Yes, this module requires the following:
#
# WWW::Babelfish
# libwww (a bundle)
# URI
# MIME-Base64
# HTML::Parser
# HTML-Tagset
# libnet (you probably already have this)
# Digest::MD5
# IO::String
@ISA = qw(BotModules);
1;
# -- #mozilla was here! --
# *** Signoff: techbot_Hixie (~techbot_Hixie@129.59.231.42) has left IRC [Leaving]
# <timeless> oops, i killed your techbot
# RegisterConfig - Called when initialised, should call registerVariables
sub RegisterConfig {
my $self = shift;
$self->SUPER::RegisterConfig(@_);
$self->registerVariables(
# [ name, save?, settable? ]
['languages', 1, 1, {
'en' => 'English',
'fr' => 'French',
'de' => 'German',
'it' => 'Italian',
'es' => 'Spanish',
}], # short code => Babelfish Language Name
['defaultLanguage', 1, 1, 'en'],
);
}
sub Help {
my $self = shift;
my ($event) = @_;
my @languages = keys(%{$self->{'languages'}});
local $";
$" = '|';
return {
'' => 'The WWW module provides a web interface.',
'translate' => "Uses babelfish.altavista.com to translate something. Syntax: \'translate [from (@languages)] [to (@languages)] sentence\'",
'x' => 'Same as translate (which see).',
};
}
sub Told {
my $self = shift;
my ($event, $message) = @_;
if ($message =~ /^\s*(?:translate|x)\s+(.*?)\s*$/osi) {
$self->Translate($event, $1);
} else {
return $self->SUPER::Told(@_);
}
return 0; # dealt with it...
}
sub translate_do {
my $self = shift;
my ($event, $lang1, $lang2, $words) = @_;
my $translate_babelfish = new WWW::Babelfish();
my $result = $translate_babelfish->translate(
'source' => $self->{'languages'}->{$lang1},
'destination' => $self->{'languages'}->{$lang2},
'text' => $words,
);
if ($result !~ /^ *$/os) {
return "$event->{'from'}: $result";
} else {
my $error = $translate_babelfish->error;
if ($error =~ /^ *$/os) {
return "$event->{'from'}: I'm afraid I cannot translate that from $self->{'languages'}->{$lang1} to $self->{'languages'}->{$lang2}.";
} else {
return "$event->{'from'}: $error";
}
}
}
# ChildCompleted - Called when a child process has quit
sub ChildCompleted {
my $self = shift;
my ($event, $type, $output, @data) = @_;
if ($type eq 'babelfish') {
$self->say($event, $output);
} else {
$self->SUPER::ChildCompleted($event, $type, $output, @data);
}
}
sub Translate {
my $self = shift;
my ($event, $rest) = @_;
my ($lang1, $lang2, $words) = (
$self->{'defaultLanguage'},
$self->{'defaultLanguage'},
);
my @languages = keys(%{$self->{'languages'}});
local $";
$" = '|';
# check syntax
if ($rest =~ /^\s*from\s+(@languages)\s+to\s+(@languages)\s+(.+)$/os) {
$lang1 = $1;
$lang2 = $2;
$words = $3;
} elsif ($rest =~ /^\s*to\s+(@languages)\s+from\s+(@languages)\s+(.+)$/os) {
$lang2 = $1;
$lang1 = $2;
$words = $3;
} elsif ($rest =~ /^\s*(from|to)\s+(@languages)\s+(.+)$/os) {
$lang1 = $2 if $1 eq 'from';
$lang2 = $2 if $1 eq 'to';
$words = $3;
} else {
$self->say($event, "$event->{'from'}: Noooo... That\'s not the right syntax at all! Try something like \'translate [from (@languages)] [to (@languages)] sentence\'");
return;
}
# translate
if ($lang1 eq $lang2) {
$self->say($event, "$event->{'from'}: Erm, well, translating from one language to the same language... doesn't change anything!");
} else {
$self->spawnChild($event, \&translate_do, [$self, $event, $lang1, $lang2, $words], 'babelfish', []);
}
}

44
webtools/mozbot/BotModules/UUIDGen.bm Normal file
View File

@ -0,0 +1,44 @@
################################
# UUIDGen Module #
################################
# "uuidgen" should be installed on the path somewhere.
# you can get the source of uuidgen from CVS, see:
# http://lxr.mozilla.org/mozilla/source/webtools/mozbot/uuidgen/
package BotModules::UUIDGen;
use vars qw(@ISA);
@ISA = qw(BotModules);
1;
sub Help {
my $self = shift;
my ($event) = @_;
return {
'' => 'This module is an interface to the uuidgen application.',
'uuid' => 'Generates a UUID.',
};
}
sub Told {
my $self = shift;
my ($event, $message) = @_;
if ($message =~ /^\s*uuid(?:[\s,!?]+please)?[\s,!?]*\s*$/osi) {
$self->spawnChild($event, 'uuidgen', [], 'UUID', []);
} else {
return $self->SUPER::Told(@_);
}
return 0; # we've dealt with it, no need to do anything else.
}
# ChildCompleted - Called when a child process has quit
sub ChildCompleted {
my $self = shift;
my ($event, $type, $output, @data) = @_;
if ($type eq 'UUID') {
$self->say($event, $output);
} else {
return $self->SUPER::ChildCompleted(@_);
}
}

116
webtools/mozbot/BotModules/WWW.bm Normal file
View File

@ -0,0 +1,116 @@
################################
# WWW Module #
################################
package BotModules::WWW;
use vars qw(@ISA);
@ISA = qw(BotModules);
1;
# RegisterConfig - Called when initialised, should call registerVariables
sub RegisterConfig {
my $self = shift;
$self->SUPER::RegisterConfig(@_);
# $self->registerVariables(
# # [ name, save?, settable? ]
# ['x', 1, 1, 0],
# );
}
sub Help {
my $self = shift;
my ($event) = @_;
return {
'' => 'The WWW module provides a web interface.',
'wwwsize' => 'Reports on the size of a webpage. Syntax: \'wwwsize http://...\'',
'wwwlint' => 'Reports on whether the webpage contains any obvious (I mean _really_ obvious) no-nos like <layer> or document.all. Syntax: \'wwwlint http://...\'',
'wwwdoctype' => 'Reports on the doctype of a webpage. (Warning: Does not check that the doctype is not commented out!) Syntax: \'wwwdoctype http://...\'',
};
}
sub Told {
my $self = shift;
my ($event, $message) = @_;
if ($message =~ /^\s*wwwsize\s+(.+?)\s*$/osi) {
$self->Fetch($event, $1, 'size');
} elsif ($message =~ /^\s*wwwlint\s+(.+?)\s*$/osi) {
$self->Fetch($event, $1, 'lint');
} elsif ($message =~ /^\s*wwwdoctype\s+(.+?)\s*$/osi) {
$self->Fetch($event, $1, 'doctype');
} else {
return $self->SUPER::Told(@_);
}
return 0; # dealt with it...
}
sub Fetch {
my $self = shift;
my ($event, $uri, $type) = @_;
$self->getURI($event, $uri, $type);
}
sub GotURI {
my $self = shift;
my ($event, $uri, $output, $type) = @_;
my $chars = length($output);
if ($type eq 'size') {
if ($chars) {
$self->say($event, "$uri is $chars bytes long.");
} else {
$self->say($event, "$uri is either empty, or I could not download it.");
}
} elsif ($type eq 'lint') {
# ignore whether things are commented out or not.
unless ($chars) {
$self->say($event, "$uri is either empty, or I could not download it.");
} else {
my @status;
if ($output =~ /document\.all/os) {
push(@status, 'document.all');
}
if ($output =~ /document\.layers/os) {
push(@status, 'document.layers');
}
if ($output =~ /<i?layer/osi) {
push(@status, 'the <layer> tag');
}
if (@status) {
my $status = shift(@status);
if (@status) {
while (scalar(@status) > 1) {
$status .= ', '.shift(@status);
}
$status .= ' and '.shift(@status);
}
$self->say($event, "$uri contains $status.");
} else {
$self->say($event, "$uri doesn't have any _obvious_ flaws..."); # XXX doesn't work! try php.net
}
}
} elsif ($type eq 'doctype') {
# assume doctype is not commented.
unless ($chars) {
$self->say($event, "$uri is either empty, or I could not download it.");
} elsif ($output =~ /(<!DOCTYPE\s[^>]*>)/osi) {
my $doctype = $1;
$doctype =~ s/[\n\r]+/ /gosi;
# -- #mozilla was here --
# <Hixie> it would break 99% of the web if we didn't do it that way.
# <Hixie> including most of my test cases ;-)
# <dbaron> test cases don't matter...
# <dbaron> you'll fix them if we decide they're wrong
# <dbaron> but the web is a problem
if (length($doctype) > 220) {
$self->say($event, "$uri has a corrupted doctype (or maybe it has an internal subset - yuck).");
} else { # 220 is not arbitrary. The following line should ideally fit within the 255 char limit.
$self->say($event, "$uri has the following doctype: $doctype");
}
} else {
$self->say($event, "$uri has no specified doctype.");
}
} else {
return $self->SUPER::GotURI(@_);
}
}

55
webtools/mozbot/BotModules/Wishlist.bm Normal file
View File

@ -0,0 +1,55 @@
################################
# Wishlist Module #
################################
package BotModules::Wishlist;
use vars qw(@ISA);
@ISA = qw(BotModules);
1;
sub Help {
my $self = shift;
my ($event) = @_;
my $reply = {
'' => 'A module to store wishlist items, typically used to file bugs on the bot, but really for that you should use Bugzilla -- http://bugzilla.mozilla.org/ -- component MozBot in product WebTools.',
'wish' => 'Adds an item to the wishlist. Please use Bugzilla for this purpose though, see http://bugzilla.mozilla.org/ product WebTools, component Mozbot. Syntax: \'wish <text of wish>\'',
'wishes' => 'Causes the bot to list all the wishes that have been made. Since this may be long, it may only be done in a /msg. Syntax: \'wishes\'',
};
$$reply{''} .= ' To remove wishes, use the following command: vars Wishlist wishes \'-<full text of the wish to remove>\'' if $self->isAdmin($event);
return $reply;
}
# RegisterConfig - Called when initialised, should call registerVariables
sub RegisterConfig {
my $self = shift;
$self->SUPER::RegisterConfig(@_);
$self->registerVariables(
# [ name, save?, settable? ]
['wishes', 1, 1, []],
['reply', 1, 1, 'Noted!'],
);
}
sub Told {
my $self = shift;
my ($event, $message) = @_;
if ($message =~ /^\s*(?:i\s+)?wish(?:list)?[-\s:.,;!]+(...+?)\s*$/osi) {
push(@{$self->{'wishes'}}, "<$event->{'from'}> $1");
$self->say($event, "$event->{'from'}: $self->{'reply'}");
$self->saveConfig();
} elsif ($message =~ /^\s*wishes[\s?]*$/osi) {
if (@{$self->{'wishes'}}) {
$self->directSay($event, 'Wishes:');
foreach (@{$self->{'wishes'}}) {
$self->directSay($event, " $_");
}
$self->directSay($event, 'End of wishes.');
} else {
$self->directSay($event, 'Noone has wished for anything!');
}
$self->channelSay($event, "$event->{'from'}: wishlist /msg'ed");
} else {
return $self->SUPER::Told(@_);
}
return 0; # we've dealt with it, no need to do anything else.
}

801
webtools/mozbot/BotModules/devel.txt Normal file
View File

@ -0,0 +1,801 @@
MODULE API DOCUMENTATION
========================
This file documents the mozbot 2.0 bot module API.
Revisions are welcome.
Sample module
-------------
Here is the HelloWorld module:
################################
# Hello World Module #
################################
package BotModules::HelloWorld;
use vars qw(@ISA);
@ISA = qw(BotModules);
1;
sub Help {
my $self = shift;
my ($event) = @_;
return {
'' => 'This is the demo module that says Hello World.',
'hi' => 'Requests that the bot emit a hello world string.',
};
}
sub Told {
my $self = shift;
my ($event, $message) = @_;
if ($message =~ /^\s*hi\s*$/osi) {
$self->say($event, 'Hello World!');
} else {
return $self->SUPER::Told(@_);
}
}
################################
Creating a module
-----------------
Modules are perl objects with names that start with 'BotModules::'
and that are stored in files with the '.bm' extension in the
'BotModules' directory. The first non-comment line of each module
should be the 'package' line, which in the HelloWorld module reads:
package BotModules::HelloWorld;
For a module to work correctly, it should inherit from the
'BotModules' module (which is implemented internally in the main bot
executable). This is done by including the following two lines
immediately after the 'package' line:
use vars qw(@ISA);
@ISA = qw(BotModules);
Since modules are dynamically loaded and unloaded, they should avoid
using package globals. All variables should be stored in the '$self'
blessed hashref. For more details, see the documentation of the
'Initialise' function (below). Another result of the dynamic nature
of modules is that they should not use BEGIN {} or END {} blocks, nor
should they execute any code during their evaluation. Thus,
immediately after the @ISA... line, the module should return success.
This can be done easily:
1;
Following this, you are free to implement all the functions you need
for your module. Certain functions have certain calling semantics,
these are described below.
Module Functions
----------------
This section contains the names and descriptions of the functions in
your module that will be called automatically depending on what is
happening on IRC.
All your functions should start by shifting the $self variable from the
argument list:
my $self = shift;
After this, it is common to get the other variables too:
my ($event, @anythingElse) = @_;
...where the bit in the brackets is given in the brackets of the
definitions of the functions as shown below. For example, for
JoinedChannel it would be ($event, $channel), so a function to override
the default JoinedChannel action would be something like:
sub JoinedChannel {
my $self = shift;
my ($event, $channel) = @_;
# ...
return $self->SUPER::JoinedChannel($event, $channel); # call inherited method
}
Many functions have to return a special value, typically 0 if the event
was handled, and 1 if it was not.
What actually happens is that for every event that occurs, the bot
has a list of event handlers it should call. For example, if
someone says 'bot: hi' then the bot wants to call the Told()
handler and the Baffled() handler. It first calls the Told()
handler of every module. It then looks to see if any of the
handlers returned 0. If so, it stops. Note, though, that every
Told() handler got called! If none of the handlers returned 0,
then it looks to see what the highest return value was. If it was
greater than 1, then it increments the 'level' field of the $event
hash (see below) and calls all the Told() handlers that returned 1
or more again. This means that if your module decides whether or
not to respond by looking at a random number, it is prone to being
confused by another module!
YOU SHOULD NOT USE RANDOM NUMBERS TO DECIDE WHETHER OR NOT TO
RESPOND TO A MESSAGE!
Once all the relevant Told() handlers have been called again, the
bot once again examines all the return results, and stops if any
returned 0. If none did and if the current value of the level field
is less than the highest number returned from any of the modules,
then it repeats the whole process again. Once the level field is
equal to the highest number returned, then, if no module has ever
returned 0 in that whole loopy time, it moves on to the next
handler in the list (in this case Baffled()), and does the
_entire_ process again.
You may be asking yourself "Why oh why!". It is to allow you to
implement priority based responses. If your module returns '5' to
the Told() function, and only handles the event (i.e., only
returns 0) once the level field is 5, then it will only handle the
event if no other module has wanted to handle the event in any of
the prior levels.
It also allows inter-module communication, although since that is
dodgy, the details are left as an exercise to the reader.
Important: if you use this, make sure that you only reply to the
user once, based on the $event->{'level'} field. e.g., if you
replied when level was zero, then don't reply _again_ when it is
set to 1. This won't be a problem if your module only returns 1
(the default) or 0 (indicating success).
*** Help($event)
Every module that does anything visible should provide a 'Help'
function. This is called by the General module's 'help' command
implementation.
This function should return a hashref, with each key representing a
topic (probably a command) and each value the relevant help string.
The '' topic is special and should contain the help string for the
module itself.
*** Initialise()
Called when the module is loaded.
No special return values.
*** Schedule($event)
Schedule - Called after bot is set up, to set up any scheduled
tasks. See 'schedule' in the API documentation below for information
on how to do this.
No special return values. Always call inherited function!
*** JoinedIRC($event)
Called before joining any channels (but after module is setup). This
does not get called for dynamically installed modules.
No special return values. Always call inherited function!
*** JoinedChannel($event, $channel)
Called after joining a channel for the first time, for example if
the bot has been /invited.
No special return values. Always call inherited the function, as this
is where the autojoin function is implemented.
*** PartedChannel($event, $channel)
Called after the bot has left a channel, for example if the bot has
been /hicked.
No special return values. Always call inherited the function, as this
is where the autopart function is implemented.
*** InChannel($event)
Called to determine if the module is 'in' the channel or not.
Generally you will not need to override this.
Return 0 if the module is not enabled in the channel in which the
event occured, non zero otherwise.
*** IsBanned($event)
Same as InChannel(), but for determining if the user is banned or
not.
Return 1 if the user that caused the event is banned from this
module, non zero otherwise.
*** Log($event)
Called once for most events, regardless of the result of the
other handlers. This is the event to use if you wish to log
everything that happens on IRC (duh).
No return value.
*** Baffled($event, $message)
Called for messages prefixed by the bot's nick which we don't
understand (i.e., that Told couldn't deal with).
Return 1 if you can't do anything (this is all the default
implementation of Baffled() does).
*** Told($event, $message)
Called for messages heard that are prefixed by the bot's nick. See
also Baffled.
Return 1 if you can't do anything (this is all the default
implementation of Told() does).
*** Heard($event, $message)
Called for all messages not aimed directly at the bot, or those
aimed at the bot but with no content (e.g., "bot!!!").
Return 1 if you can't do anything (this is all the default
implementation of Heard() does).
*** Felt($event, $message)
Called for all emotes containing bot's nick.
Return 1 if you can't do anything (this is all the default
implementation of Felt() does).
*** Saw($event, $message)
Called for all emotes except those directly at the bot.
Return 1 if you can't do anything (this is all the default
implementation does).
*** Invited($event, $channel)
Called when bot is invited into another channel.
Return 1 if you can't do anything (this is all the default
implementation does).
*** Kicked($event, $channel)
Called when bot is kicked out of a channel.
Return 1 if you can't do anything (this is all the default
implementation does).
*** ModeChange($event, $what, $change, $who)
Called when either the channel or a person has a mode flag changed.
Return 1 if you can't do anything (this is all the default
implementation does).
*** GotOpped($event, $channel, $who)
Called when the bot is opped. (Not currently implemented.)
Return 1 if you can't do anything (this is all the default
implementation does).
*** GotDeopped($event, $channel, $who)
Called when the bot is deopped. (Not currently implemented.)
Return 1 if you can't do anything (this is all the default
implementation does).
*** Authed($event, $who)
Called when someone authenticates with us. Note that you cannot
do any channel-specific operations here since authentication is
done directly and without any channels involved. (Of course,
you can always do channel-wide stuff based on a channel list...)
Return 1 if you can't do anything (this is all the default
implementation does).
*** SpottedNickChange($event, $from, $to)
Called when someone changes their nick. You cannot use directSay
here, since $event has the details of the old nick. And 'say' is
useless since the channel is the old userhost string... This may be
changed in a future implementation.
Return 1 if you can't do anything (this is all the default
implementation does).
*** SpottedTopicChange($event, $channel, $newtopic)
Called when the topic in a channel is changed.
Return 1 if you can't do anything (this is all the default
implementation does).
*** SpottedJoin($event, $channel, $who)
Called when someone joins a channel.
Return 1 if you can't do anything (this is all the default
implementation does).
*** SpottedPart($event, $channel, $who)
Called when someone leaves a channel.
Return 1 if you can't do anything (this is all the default
implementation does).
*** SpottedKick($event, $channel, $who)
Called when someone leaves a channel, um, forcibly.
Return 1 if you can't do anything (this is all the default
implementation does).
*** SpottedQuit($event, $who, $why)
Called when someone leaves a server. You can't use say or directSay
as no channel involved and the user has quit, anyway (obviously).
This may change in future implementations (don't ask me how, please...).
Return 1 if you can't do anything (this is all the default
implementation does).
*** SpottedOpping($event, $channel, $who)
Called when someone is opped. (Not currently implemented.)
Return 1 if you can't do anything (this is all the default
implementation does).
*** SpottedDeopping($event, $channel, $who)
Called when someone is... deopped, maybe? (Not currently implemented.)
Return 1 if you can't do anything (this is all the default
implementation does).
*** Scheduled($event, @data)
Called when a scheduled timer triggers. (See 'schedule' in the next
section to see how to schedule stuff.) By default, if the first
element of the @data array is a coderef, then the coderef is called
with ($event,@data) as the arguments. Otherwise, 'debug' is called
(see below).
No special return values. Always call inherited function if you
cannot handle the scheduled event yourself.
*** GotURI($event, $uri, $contents, @data)
Called when a requested URI has been downloaded. $contents contains
the actual contents of the file. See getURI().
No special return values.
*** ChildCompleted($event, $type, $output, @data)
Called when a spawned child has completed. $output contains
the output of the process. $type contains the child type as
given to the spawnChild() API function (which see).
No special return values. Always call the inherited function if
you cannot handle the given '$type'!
*** RegisterConfig()
Called when initialised, should call registerVariables(), which see
below.
No special return values. Always call inherited function!
*** Set($event, $variable, $value)
Called to set a variable to a particular value.
Should return one of the following:
-1 - silent success (caller should not report back to user)
0 - success
1 - can't set variable because it is of type ref($module->{$variable})
2 - variable not found or not writable (if $module->{$variable})
3 - variable is list and wrong format was used
4 - variable is hash and wrong format was used
9 - unknown error
Note that error codes 1-4 are probably too specific to the default
'Set' function to be of any use. Reporting your own error messages
is fine.
Always call inherited function if you cannot set the variable yourself!
*** Get($event, $variable)
Called to get a particular variable.
Should return the value of the variable. Default returns the value
of $self->{$variable}.
Always call inherited function if you cannot get the variable yourself!
The $event variable is a hash with the following keys:
'bot' => the IRC bot object - DO NOT USE THIS!!! [1]
'channel' => the channel the event occured in, or '' if n/a [2]
'from' => the nick of the person who created the event, if any
'target' => the target of the 'say' function (channel || from)
'user' => the userhost of the event
'data' => the main data of the event
'to' => the target of the event
'subtype' => the IRC module's idea of what the event was [1]
'maintype' => the name of the first handler called (eg. 'Told')
'level' => the number of times the handler has been called in a row
'userName' => the name of the user as they authenticated
'userFlags' => used internally for the implementation of isAdmin(). [1]
'nick' => the nick of the bot
It is passed to most functions, as the first parameter. Modify at your
own risk! ;-) If you do write to this hash at all, ensure that you make
a 'local' copy first. See the 'Parrot' module for an example of safely
modifying the $event hash. Note that some of these fields may be
inaccurate at times, due to peculiarities of the IRC protocol.
[1]: These fields are dependent on the underlying implementation, so
if you use them then your modules will not be compatible with any other
implementations that use the same API. The 'bot' field in particular is
a blessed reference to a Net::IRC::Connection object in this
implementation, and is passed around so that the API functions know
what to operate on. However, in a POE implementation it could be
something totally different, maybe even undef. There are some other
fields in the $event hash that start with an underscore (in particular
there is '_event'). Do not even _think_ about using those. Using them
is akin to hard-coding the ionode of the 'ls' program into your source
so that you can read directories by branching to a disk address.
[2]: The 'channel' field is ALWAYS lowercase. You should always lowercase
any channel names you get from users before using them in comparisons or
hash lookups.
Module API
----------
This section contains the names and descriptions of the functions
that your module can call. While you can override these, it is not
recommended.
*** debug(@messages)
Outputs each item in @messages to the console (or the log file if
the bot has lost its controlling tty).
Example:
$self->debug('about to fetch listing from FTP...');
*** saveConfig()
Saves the state of the module's registered variables to the
configuration file. This should be called when the variables have
changed.
Example:
$self->saveConfig(); # save our state!
*** registerVariables( [ $name, $persistent, $settable, $value ] )
Registers variables (duh). It actually takes a list of arrayrefs.
The first item in each arrayref is the name to use (the name of the
variable in the blessed hashref that is the module's object, i.e.
$self). The second controls if the variable is saved when
saveConfig() is called. If it is set to 1 then the variable is
saved, if 0 then it is not, and if undef then the current setting is
not changed. Similarly, the third item controls whether or not the
variable can be set using the 'vars' command (in the Admin
module). 1 = yes, 0 = no, undef = leave unchanged. The fourth value,
if defined, is used to set the variable. See the Initialise
function's entry for more details.
Example:
$self->registerVariables(
[ 'ftpDelay', 1, 1, 60 ],
[ 'ftpsite', 1, 1, 'ftp.mozilla.org' ],
);
*** schedule($event, $time, $times, @data)
Schedules one or more events. $event is the usual event hash. $time
is the number of seconds to wait. It can be a scalarref to a
variable that contains this number, too, in which case it is
dereferenced. This comes in useful for making the frequency of
repeating events customisable. $times is the number of times to
perform the event, which can also be -1 meaning 'forever'. @data
(the remainder of the parameters) will be passed, untouched, to the
event handler, Scheduled. See the previous section.
Example:
$self->schedule($event, \$self->{'ftpDelay'}, -1, 'ftp', \$ftpsite);
*** getURI($event, $uri, @data)
Gets a URI in the background then calls GotURI (which see, above).
Example:
$self->getURI($event, $ftpsite, 'ftp');
*** spawnChild($event, $command, $arguments, $type, $data)
Spawns a child in the background then calls ChildCompleted (which see,
above). $arguments and $data are array refs! $command is either a
command name (e.g., 'wget', 'ls') or a CODEREF. If it is a CODEREF,
then you will be wanting to make sure that the first argument is
the object reference, unless we are talking inlined code or something...
Example:
$self->spawnChild($event, '/usr/games/fortune', ['-s', '-o'],
'fortune', [@data]);
*** getModule($name)
Returns a reference to the module with the given name. In general you
should not need to use this, but if you write a management module, for
instance, then this could be useful. See God.bm for an example of this.
IT IS VITAL THAT YOU DO NOT KEEP THE REFERENCE
THAT THIS FUNCTION RETURNS!!!
If you did so, the module would not get garbage collected if it ever
got unloaded or some such.
Example:
my $module = $self->getModule('Admin');
push(@{$module->{'files'}}, 'BotModules/SupportFile.pm');
*** unescapeXML($xml)
Performs the following conversions on the argument and returns the result:
&apos; => '
&quot; => "
&lt; => <
&gt; => >
&amp; => &
Example:
my $text = $self->unescapeXML($output);
*** tellAdmin($event, $data);
Tries to tell an administrator $data. As currently implemented, only
one administrator will get the message, and there is no guarentee
that they will read it or even that the admin in question is
actually on IRC at the time.
Example:
$self->tellAdmin($event, 'Someone just tried to crack me...');
*** say($event, $data)
Says $data in whatever channel the event was spotted in (this can be
/msg if that is how the event occured).
Example:
$self->say($event, 'Yo, dude.');
*** announce($event, $data)
Says $data in all the channels the module is in.
Example:
$self->announce($event, 'Bugzilla is back up.');
*** directSay($event, $data)
Sends a message directly to the cause of the last event (i.e., like
/msg). It is recommended to use 'say' normally, so that users have a
choice of whether or not to get the answer in the channel (they
would say their command there) or not (they would /msg their
command).
Example:
$self->directSay($event, 'Actually, that\'s not right.');
*** directSay($event, $data)
Sends a message to the channel in which the message was given.
If the original command was sent in a /msg, then this will result
in precisely nothing. Useful in conjunction with directSay() to
make it clear that a reply was sent privately.
Example:
$self->directSay($event, $veryLongReply);
$self->channelSay($event, "$event->{'from'}: data /msg'ed");
*** emote($event, $what)
*** directEmote($event, $what)
Same as say() and directSay(), but do the equivalent of /me instead.
Examples:
$self->emote($event, "slaps $event->{'from'} with a big smelly trout.");
$self->directEmote($event, "waves.");
*** sayOrEmote($event, $what)
*** directSayOrEmote($event, $what)
Call say (directSay) or emote (directEmote) based on the contents of $what.
If $what starts with '/me' then the relevant emote variation is called,
otherwise the say variations are used. The leading '/me' is trimmed before
being passed on.
Examples:
$self->sayOrEmote($event, $greeting);
$self->directSayOrEmote($event, $privateMessage);
*** isAdmin($event)
Returns true if the cause of the event was an authenticated administrator.
Example:
if ($self->isAdmin($event)) { ... }
*** setAway($event, $message)
Set the bot's 'away' flag. A blank message will mark the bot as
back. Note: If you need this you are doing something wrong!!!
Remember that you should not be doing any lengthy processes since if
you are away for any length of time, the bot will be kicked!
Also note that in 2.0 this is not throttled, so DO NOT call this
repeatedly, or put yourself in any position where you allow IRC
users to cause your module to call this. Otherwise, you open
yourself to denial of service attacks.
Finally, note that calling 'do', 'emote', 'say', and all the
related functions will also reset the 'away' flag.
Example:
$self->setAway($event, 'brb...');
*** setNick($event, $nick)
Set the bot's nick. This handles all the changing of the internal
state variables and saving the configuration and everything.
It will also add the nick to the list of nicks to try when
the bot finds its nick is already in use.
Note that in 2.0 this is not throttled, so DO NOT call this
repeatedly, or put yourself in any position where you allow IRC
users to cause your module to call this. Otherwise, you open
yourself to denial of service attacks.
Example:
$self->setNick($event, 'zippy');
*** mode($event, $channel, $mode, $argument)
Changes a mode of channel $channel.
Example:
$self->mode($event, $event->{'channel'}, '+o', 'Hixie');
*** invite($event, $who, $channel)
Invite $who to channel $channel. This can be used for intrabot
control, or to get people into a +i channel, for instance.
Example:
$self->invite($event, 'Hixie', '#privateChannel');
*** prettyPrint($preferredLineLength, $prefix, $indent, $divider, @input)
Takes @input, and resorts it so that the lines are of roughly the same
length, aiming optimally at $preferredLineLength, prefixing each line
with $indent, placing $divider between each item in @input if they
appear on the same line, and sticking $prefix at the start of it all on
the first line. The $prefix may be undef.
Returns the result of all that.
This is what the 'help' command uses to pretty print its output.
Example:
my @result = $self->prettyPrint($linelength, undef, 'Info: ', ' -- ', @infoItems);
*** wordWrap($preferredLineLength, $prefix, $indent, $divider, @input)
Takes @input, and places each item sequentially on lines, aiming optimally
at $preferredLineLength, prefixing each line with $indent, placing $divider
between each item in @input if they appear on the same line, and sticking
$prefix at the start of it all on the first line, without ever cutting
items across lines. The $prefix may be undef.
Returns the result of all that.
Example:
my @result = $self->wordWrap($linelength, undef, 'Info: ', ' ', split(/\s+/os, @lines);
*** days($time)
Returns a string describing the length of time between $time and now.
Example:
$self->debug('uptime: '.$self->days($^T));
*** sanitizeRegexp($regexp)
Checks to see if $regexp is a valid regular expression. If it is, returns
the argument unchanged. Otherwise, returns quotemeta($regexp), which should
be safe to use in regular expressions as a plain text search string.
Do not add prefixes or suffixes to the pattern after sanitizing it.
Example:
$pattern = $self->sanitizeRegexp($pattern);
$data =~ /$pattern//gosi;
-- end --

361
webtools/mozbot/INSTALL Normal file
View File

@ -0,0 +1,361 @@
_ _
m o z i l l a |.| o r g | |
_ __ ___ ___ ___| |__ ___ | |_
| '_ ` _ \ / _ \_ / '_ \ / _ \| __|
| | | | | | (_) / /| |_) | (_) | |_
|_| |_| |_|\___/___|_.__/ \___/ \__|
=======================- 2 . 0 -==
INSTALLATION
------------
You will need the following programs and libraries to run mozbot2:
perl
wget
Net::IRC
Net::SMTP
IO::Select
IO::Pipe
These packages may have additional requirements of their own.
In order to do anything useful with mozbot2, you will need some Bot
Modules. Several are included in this distribution, and they may have
requirements above and beyond those given above.
Once you have set up all the packages on which mozbot2 depends, make
mozbot.pl executable:
chmod +x mozbot.pl
This is needed since mozbot2 will occasionally attempt to restart
itself (e.g. if its source code is changed).
Then, simply run mozbot.pl:
./mozbot.pl
Currently, you MUST run mozbot from the directory in which mozbot.pl
is placed. This may be changed in a future version.
SECURITY
--------
Since mozbot interacts with the outside world, do not run it as a
privileged user!!!
In addition, since mozbot calls external programs (currently perl and
wget, possibly others in future versions) make sure that none of the
directories on your path are writable by untrusted users! (e.g., do
not put /tmp into your path!)
Make sure that '.' is not in your path! This is a security risk in a
situation like this, and perl will rightly refuse to execute external
programs (like wget, used to get remote URIs for many functions) if
'.' is on your path.
Do not run the bot straight into a public channel on the first run!
One important reason not to load the bot straight into a public
channel on the first run is that until it has been properly
configured, it will have a well defined username and password to
access all its admin functions. Thus a malicious user could hijack the
bot the moment it joined the channel.
If this is a serious problem for you (e.g., your users are of a
particularly high calibre and are doing regular polls of the /who
command to see if any bots join) then use another server, such as one
that you control, on localhost!
See the "Administration" section for instructions on how to change the
administration password (important!).
Note: Passwords are printed in clear text on the console and in the
log files. Secure them accordingly.
The default setting is for mozbot to run with taint checking
enabled. I *STRONGLY* recommend not changing this.
CONFIGURATION
-------------
When you start up mozbot for the first time, it will prompt you for
the following information:
1. IRC server.
What machine you want the bot to connect to. At the moment,
mozbot only supports connecting to a single server at a time. It
would require a *significant* amount of work to change this.
2. Port.
What port to connect to on the IRC server. Typically, this will
be 6667 or therabouts.
3. Channels.
What channels the bot should initially connect to. It is
recommended that this just be a bot channel or a test channel,
for example #mozbot, since running a bot for the first time
before it is known to be ready is a bad idea. You can enter more
than one channel, just hit enter after each one (leave a blank
line when you have finished). Currently, mozbot does not support
joining keyed channels. To make oopsbot join a keyed channel,
you must unkey the channel, make your bot join it, then rekey
it. This may change in a future version, but would require a lot
of work.
4. Your e-mail address.
In case of great difficulties, mozbot may try to e-mail you. If
this happens, it will use the e-mail address you gave here. This
only happens if (a) it absolutely cannot connect to the server
you gave it, or (b) it cannot find a nick that is not in use.
5. SMTP server.
The name of the SMTP server it should try to talk with in order
to send you mail. If you type in an invalid server name, it will
just fail to send mail and instead will complain bitterly to its
console.
6. Nicks.
Some nicks for IRC. For example, 'mozbot'. It is customary to
clearly mark the bot as being non-human, for example by putting
'bot' in the name. You should enter several possibilities
here. Hit enter after each one. Leave a blank line to finish.
Once the bot is running, there are many other things that can be
configured with it. See "variables".
Note. The bot will treat all channel names as lowercase to avoid case
sensitivity issues.
LOGGING
-------
Normally, mozbot will output its complaints to the console
(stdout). If you run mozbot in an xterm or screen session, you can
therefore easily keep track of what is going on.
It will also continuously log output to ~/logs/$0.$$.log, where $0 is
the file name and $$ is the PID. You may wish to set up a cron job to
prune this file on a regular basis, it gets LARGE. However, it can
sometimes be the only way to track down how your system was
compromised if it turns out that mozbot has a security flaw.
Control over the logging is currently not available. This may change
in future versions.
Note that when the bot forks and then outputs a message, which happens
occasionally, it will therefore use a new log file for the forked
process. This should only happen when something bad happens,
e.g. something forces the bot to restart or the bot forks and then the
child enters a bad state.
Note. Authentication passwords will be displayed in cleartext on the
console and in the log files.
ADMINISTRATION
--------------
Once the bot is active and on the IRC server, it starts to listen to
all messages seen on any channels on which it is present, and all
messages sent to it using /msg.
Your first task should be to change the admin password. To do this,
authenticate yourself using the "auth" command. The default username
is "admin", and the default password is "password". If the bot is
called "mozbot", then the command to authenticate would be as follows:
/msg mozbot auth admin password
The bot should respond with "Hi admin!".
Now create yourself an account by adding a username/password pair to
the bot. You do this with the "newuser" command. Next, you should
bless this new user, making it a bot administrator. This is done using
these commands:
/msg mozbot newuser <username> <password> <password>
/msg mozbot bless <username>
Now authenticate yourself again, as the new user:
/msg mozbot auth <username> <password>
The moment you authenticate as the new admin, the default admin
account is deleted.
You are now in a position to add the modules you want and to put the
bot in the channels you want it in.
To load modules is easy.
/msg mozbot load module
...where "module" is a module name, such as "HelloWorld" (note that
the ".bm" extension is not included).
By default, modules will be enabled in all channels. See the
"variables" section below to change this.
HINTS
-----
If the bot goes mad and starts flooding a channel -- e.g., if someone
keeps asking it for information -- then authenticate and then send it
the following message:
/msg mozbot shutup please
It should respond within a few seconds. You can authenticate while it
is speaking, that is no problem.
VARIABLES
---------
For information on changing variables on the fly, use the "vars"
command:
/msg mozbot vars
Each module has several variables that you can change. You can see
what they are by typing:
/msg mozbot vars module
...where module is the module in question. These always include
"Admin" and "General". Admin is only available to authenticated users,
and provides the commands such as "shutdown", "cycle", "leave",
"password", and so on. "General" provides the "help" command to
everyone.
The main variables are:
channels -- which channels the module should listen in, and which
channels the module should send announcements to. Must be in
lowercase!
autojoin -- whether (1) or not (0) the module should automatically
add a new channel to its "channels" list when the bot joins a new
channel. If this is not enabled, then you will have to add new
channels to the "channels" list each time.
channelsBlocked -- channels that will not be autojoined, so if the
module has been disabled, it won't rejoin the channel if it is
kicked then reinvited.
denyusers -- user@host regexp masks of users that should be
completely ignored. The regexp will be placed between "^" and "$"
modifiers, so do not include them, and *do* include everything
required to make the whole user@host mask match.
allowusers -- identical in usage to denyusers, but checked first to
override it. So to give access to everyone but a few people, leave
allowusers blank and add some masks to denyusers, but to give
access to only a few people, add their user@host masks to
allowusers, and add ".*" to denyusers.
In addition, other modules may have extra variables.
The admin variable has quite a few variables, including all those that
are prompted for during initial startup. The interesting ones are:
currentnick -- the nick. This can be changed on the fly.
server, port -- the server and port to connect to. If you change
these and then cycle the bot (/msg mozbot cycle) then the bot will
change servers without shutting down.
channels -- unlike other modules, the channels variable for the
Admin module actually controls which channels the bot itself
appears in. The preferred method for controlling this is using
/invite and /kick or "go" and "leave", though (since editing the
list directly will probably require a cycle of the bot to take
effect).
admins -- the administrators. See "Administration" above.
allowInviting -- this controls whether the /invite IRC command will
be obeyed or not.
allowChannelAdmin -- this controls whether or not the bot will
accept admin commands that are given in a channel or not. In any
case, the "auth" command is never accepted in a channel.
files -- this is a list of files whose timestamps are monitored to
decide if the source code has changed. If it is established that
any of these files have changed while the bot is running, then the
bot will shutdown and restart itself. Modules are dealt with
separately, and need not be listed here. (And when modules change,
the whole bot is not restarted, only the module.)
sourceCodeCheckDelay -- number of seconds between checks of the bot
and module sources. Note that changes will only take effect after
the previous timer has passed, so changing it from 3600 (an hour)
to 10 (10 seconds) may not be of much immediate use. In these
cases, setting the variable to the new value then cycling the bot
is a good plan.
Changes to variables are usually immediately recorded in the
configuration file and will be saved for the next time the bot is
loaded.
There are three types of editable variables: scalars, arrays of
scalars, and hashes of scalars.
Scalars are easy, and lists are explained by the bot quite well, just
try to set a list and it will tell you if you are doing something
wrong!
To add a value to a hash, there is a more complex syntax. For example,
to add a new site to the list of sites that the RDF module monitors,
use the following command:
/msg mozbot vars RDF sites '+|slashdot|http://slashdot.org/slashdot.rdf'
First, note that the value is surrounded by quotes. You can nest
quotes without any problems, the quotes are just needed to
differentiate significant trailing whitespace from mistakes.
The "+" means you want to add a value to the hash (as you'll see in a
minute, to remove an item you use "-"). Then, since a hash is a
key/value pair, you have to delimit the two. In this case, we have
used "|" as a delimiter. However, you could use anything. The first
occurance tells mozbot what delimiter you have picked. The second
separates the key (in this case the site nickname) from the value (in
this case the URI). For example:
/msg mozbot vars RDF sites '+*key*value'
You could even use a letter as a delimiter, but since that is usually
a sign that you have forgotten to declare which delimiter you are
using, mozbot will warn you about this. For example (the 'users' hash,
BTW, is the hash in which all the username/password pairs are kept):
/msg mozbot vars Admin users '+sarah|lisa'
...will be treated the same as:
/msg mozbot vars Admin users '+*arah|li*a'
..., I.e. the username added would be "arah|li" and the password would
be "a". This is not a bug, it's a feature. It means you can include
any character, including "'", "|", and so on, in the key, without fear
of it being interpreted as a delimiter.
To remove a user, or any key/value pair in a hash, you use this
syntax:
/msg mozbot vars Admin users '-admin'
That's it. No need to say what the value is, since each key in a hash
has to be unique.
-- end --

514
webtools/mozbot/INSTALL.UNIX Normal file
View File

@ -0,0 +1,514 @@
_ _
m o z i l l a |.| o r g | |
_ __ ___ ___ ___| |__ ___ | |_
| '_ ` _ \ / _ \_ / '_ \ / _ \| __|
| | | | | | (_) / /| |_) | (_) | |_
|_| |_| |_|\___/___|_.__/ \___/ \__|
=======================- 2 . 0 -==
INTRODUCTION
------------
This was written as a living document. I (the author of mozbot 2.0)
tried (successfully!) to set up mozbot in a secure environment,
chrooted and setuided. This requires much more than a usual
installation. So, without further ado, over to myself in the field:
GETTING STARTED
---------------
I will first be trying to install mozbot 2.0 on a SPARC machine
running Sun Solaris. These instructions will probably work for any
sane UNIX system. If you use Windows, see the INSTALL.WIN32 file.
<ianh:~> mkdir mozbot
<ianh:~> cd mozbot
<ianh:~/mozbot> version
Machine hardware: sun4u
OS version: 5.7
Processor type: sparc
Hardware: SUNW,Ultra-60
I already had Emacs 20.7 installed on the machine, for which I must
thank Pavlov. You may, of course, use any editor of your choosing when
doing this, although if you use vi or one of its siblings then don't
even _think_ about asking me for help. (If you can understand vi I
figure mozbot should no problem.)
<ianh:~> mkdir mozbot
<ianh:~> cd mozbot
I also had several gigabytes of free disk space. You'll probably need
several hundred megabytes to do all of this (including scratch space).
(I believe the end result was around 30 megs for everything in the
chroot jail directory.)
PERL
----
The first thing on my list was to install Perl.
<ianh:~/mozbot> mkdir resources
<ianh:~/mozbot> cd resources
<ianh:~/mozbot/resources> wget http://www.perl.com/CPAN/src/stable.tar.gz
<ianh:~/mozbot/resources> tar xvfz stable.tar.gz
Next I read the README and INSTALL files:
<ianh:~/mozbot/resources> cd perl-5.6.0/
<ianh:~/mozbot/resources/perl-5.6.0> emacs-20.7 README INSTALL
This told me how to do the next few bits.
<ianh:~/mozbot/resources/perl-5.6.0> rm -f config.sh Policy.sh
<ianh:~/mozbot/resources/perl-5.6.0> sh Configure -Dprefix=/u/ianh/mozbot
By providing a prefix, the default installation directory for a lot of
modules I am about to install is automatically set up correctly. So if
you don't install Perl yourself, remember to take this into account!
Note: I didn't change any of the build options, so threads, debugging
and the like are all disabled (or at their defaults). The only things
I changed were that I answered 'n' to the question 'Binary
compatibility with Perl 5.005?', which defaulted to 'y', and I told it
not to install into '/usr/bin/perl'.
<ianh:~/mozbot/resources/perl-5.6.0> make
<ianh:~/mozbot/resources/perl-5.6.0> make test
<ianh:~/mozbot/resources/perl-5.6.0> make install
<ianh:~/mozbot/resources/perl-5.6.0> cd ..
At this point I had Perl installed correctly in my mozbot directory.
WGET
----
The next thing to install was wget.
<ianh:~/mozbot/resources> wget ftp://ftp.gnu.org/pub/gnu/wget/wget-1.6.tar.gz
<ianh:~/mozbot/resources> tar xvfz wget-1.6.tar.gz
<ianh:~/mozbot/resources> cd wget-1.6
<ianh:~/mozbot/resources/wget-1.6> emacs-20.7 README INSTALL
<ianh:~/mozbot/resources/wget-1.6> ./configure --prefix=/u/ianh/mozbot
<ianh:~/mozbot/resources/wget-1.6> make
<ianh:~/mozbot/resources/wget-1.6> make install
<ianh:~/mozbot/resources/wget-1.6> cd ..
No problems, no difficulties.
MOZBOT
------
Now, before going on any further with installing the required modules,
I needed to find what those were. Ergo, the next thing to install was
mozbot. Presumably you already have the relevant files, or know where
to get them, since you are reading a file that comes with the source.
<ianh:~/mozbot/resources> wget http://www.damowmow.com/mozilla/mozbot/mozbot.tar.gz
There is no configuration, makefile or install script for mozbot,
since there is nothing to compile or particularly install. So, I just
extracted the mozbot tarball directly inside what would be the root of
the file system when I eventually chroot()ed.
<ianh:~/mozbot/resources> cd ../..
<ianh:~> tar xvfz mozbot/resources/mozbot.tar.gz
Like all shell scripts, one thing to change about it is the location
of the Perl executable in the shebang.
<ianh:~> cd mozbot
<ianh:~/mozbot> emacs-20.7 mozbot.pl
Since I'll be running it from the version of Perl I just installed, I
changed the first line to read:
#!./bin/perl -wT
Note that this requires me to run mozbot from the mozbot directory. If
you've read the README file, you'll know that this is a prerequisite
of running mozbot anyway.
Net::IRC
--------
If you tried running mozbot now, you'd find it was missing
Net::IRC. So, guess what I installed next? ;-)
<ianh:~/mozbot> cd resources
<ianh:~/mozbot/resources> wget http://www.cpan.org/authors/id/FIMM/Net-IRC-0.70.tar.gz
<ianh:~/mozbot/resources> tar xvfz Net-IRC-0.70.tar.gz
<ianh:~/mozbot/resources> cd Net-IRC-0.70
<ianh:~/mozbot/resources/Net-IRC-0.70> emacs-20.7 README
<ianh:~/mozbot/resources/Net-IRC-0.70> ../../bin/perl Makefile.PL
<ianh:~/mozbot/resources/Net-IRC-0.70> make
<ianh:~/mozbot/resources/Net-IRC-0.70> make install
<ianh:~/mozbot/resources/Net-IRC-0.70> cd ..
It is important to use the Perl we just installed and not any other
Perl on the system, otherwise you'll get incorrect prefixes and
stuff. (I didn't bother to use the wget I just installed...)
Net::SMTP
---------
Yup, you guessed it, Net::SMTP is next.
<ianh:~/mozbot/resources> wget http://www.cpan.org/authors/id/GBARR/libnet-1.0703.tar.gz
<ianh:~/mozbot/resources> tar xvfz libnet-1.0703.tar.gz
<ianh:~/mozbot/resources> cd libnet-1.0703
<ianh:~/mozbot/resources/libnet-1.0703> emacs-20.7 README
<ianh:~/mozbot/resources/libnet-1.0703> ../../bin/perl Makefile.PL
I answered 'y' to the question 'Do you want to modify/update your
configuration (y|n) ? [no]', which was asked because the system
had already had libnet installed once.
I kept the defaults for all the options though.
<ianh:~/mozbot/resources/libnet-1.0703> make
<ianh:~/mozbot/resources/libnet-1.0703> make test
<ianh:~/mozbot/resources/libnet-1.0703> make install
<ianh:~/mozbot/resources/libnet-1.0703> cd ..
This also installed Net::FTP, which is required by some of the modules
(in particular, the FTP module!).
INITIAL CONFIGURATION
---------------------
Now I needed to set up the environment for mozbot. The only real thing
that needs setting up is the PATH variable. So:
<ianh:~/mozbot/resources> cd ..
<ianh:~/mozbot> emacs-20.7 run-mozbot-chrooted
Here are the contents of my run-mozbot-chrooted script:
export PATH=/u/ianh/mozbot/bin
./mozbot.pl
It is absolutely imperative that the path not contain '::' or '.'
anywhere, as this will be treated as the current directory, which will
then result in perl exiting with taint errors.
Now we make it executable:
<ianh:~/mozbot> chmod +x run-mozbot-chrooted
(Note. a sample run-mozbot-chrooted script is shipped with mozbot --
it still requires you to follow all these steps though.)
INITIAL RUN
-----------
At this point, mozbot is runnable... so I ran it!
<ianh:~/mozbot> ./run-mozbot-chrooted
Note that I'm running it via my script and not directly. If you were
not intending to run mozbot in a chroot() jail environment, then
'./mozbot.pl' would be sufficient.
It prompted me for various things, like servers and so on. Then it
connected without problems but with no modules set up, as I expected.
On IRC, I configured mozbot as I wanted it:
/query mozbot
mozbot auth admin password
newuser Hixie newpass newpass
bless Hixie
auth Hixie newpass
I also played a bit with the configuration variables:
vars Admin throttleTime '2.2'
This was all very well, but no modules makes mozbot a boring bot, so
the next thing was...
FILTERS
-------
I shut down mozbot ('shutdown please') and installed the filters
required by the 'Filters' BotModule.
<ianh:~/mozbot> cd resources
<ianh:~/mozbot/resources> wget ftp://ftp.debian.org/pub/mirrors/debian/dists/potato/main/source/games/filters_2.9.tar.gz
<ianh:~/mozbot/resources> tar xvfz filters_2.9.tar.gz
<ianh:~/mozbot/resources> cd filters
<ianh:~/mozbot/resources/filters> emacs-20.7 README
<ianh:~/mozbot/resources/filters> make
At this point, I edited the Makefile to change /usr/.../ so as to
point in the places we used for installing Perl.
<ianh:~/mozbot/resources/filters> make install PREFIX=/u/ianh/mozbot
<ianh:~/mozbot/resources/filters> cd ..
I should point out that this didn't go too well and I had to hack
about with the Makefile and my environment and so on, so good luck
(admittedly, Pavlov happened to install a new compiler at the same
time, and didn't bother to install a license for it, so I had a few
more problems than you should, but...).
You should also make sure that the shebang lines in the five relevant
perl scripts that you should make sure ended up in ~/mozbot/bin
actually point to the right perl executable. I had to edit the files
by hand.
Net::Telnet
-----------
In order to insult people, the Rude module needs to Telnet:
<ianh:~/mozbot/resources> wget http://www.cpan.org/authors/id/JROGERS/Net-Telnet-3.02.tar.gz
<ianh:~/mozbot/resources> tar xvfz Net-Telnet-3.02.tar.gz
<ianh:~/mozbot/resources> cd Net-Telnet-3.02
<ianh:~/mozbot/resources/Net-Telnet-3.02> emacs-20.7 README
<ianh:~/mozbot/resources/Net-Telnet-3.02> ../../bin/perl Makefile.PL
<ianh:~/mozbot/resources/Net-Telnet-3.02> make
<ianh:~/mozbot/resources/Net-Telnet-3.02> make test
<ianh:~/mozbot/resources/Net-Telnet-3.02> make install
<ianh:~/mozbot/resources/Net-Telnet-3.02> cd ..
That went a lot smoother than the filters installation, let me tell
you! ;-)
WWW::Babelfish
--------------
The translation module requires a whole bunch of other modules, mainly
due to its dependency on WWW::Babelfish, which requires half of libwww
and also IO::String. libwww itself requires another half a dozen
modules, namely URI, MIME-Base64, HTML::Parser, libnet (which I
installed earlier, thankfully), and Digest::MD5. And HTML-Parser
requires HTML-Tagset!
I found these dependencies out by browsing CPAN reading README files.
<ianh:~/mozbot/resources> lynx http://www.cpan.org/
Thankfully, they all installed rather smoothly. Here is the complete
list of commands I used to install WWW::Babelfish (starting in the
'resources' directory):
wget http://www.cpan.org/authors/id/GAAS/MIME-Base64-2.12.tar.gz
tar xvfz MIME-Base64-2.12.tar.gz
cd MIME-Base64-2.12
../../bin/perl Makefile.PL
make
make test
make install
cd ..
wget http://www.cpan.org/authors/id/GAAS/URI-1.11.tar.gz
tar xvfz URI-1.11.tar.gz
cd URI-1.11
../../bin/perl Makefile.PL
make
make test
make install
cd ..
wget http://www.cpan.org/authors/id/S/SB/SBURKE/HTML-Tagset-3.03.tar.gz
tar xvfz HTML-Tagset-3.03.tar.gz
cd HTML-Tagset-3.03
../../bin/perl Makefile.PL
make
make test
make install
cd ..
wget http://www.cpan.org/authors/id/GAAS/HTML-Parser-3.19_91.tar.gz
tar xvfz HTML-Parser-3.19_91.tar.gz
cd HTML-Parser-3.1991
../../bin/perl Makefile.PL
make
make test
make install
cd ..
wget http://www.cpan.org/authors/id/GAAS/Digest-MD5-2.13.tar.gz
tar xvfz Digest-MD5-2.13.tar.gz
cd Digest-MD5-2.13
../../bin/perl Makefile.PL
make
make test
make install
cd ..
wget http://www.cpan.org/authors/id/GAAS/libwww-perl-5.51.tar.gz
tar xvfz libwww-perl-5.51.tar.gz
cd libwww-perl-5.51
../../bin/perl Makefile.PL
make
make test
make install
cd ..
wget http://www.cpan.org/authors/id/GAAS/IO-String-1.01.tar.gz
tar xvfz IO-String-1.01.tar.gz
cd IO-String-1.01
../../bin/perl Makefile.PL
make
make test
make install
cd ..
wget http://www.cpan.org/authors/id/D/DU/DURIST/WWW-Babelfish-0.09.tar.gz
tar xvfz WWW-Babelfish-0.09.tar.gz
cd WWW-Babelfish-0.09/
../../bin/perl Makefile.PL
make
make test
make install
cd ..
Yes, this is surreal. I always knew languages were hard.
UUIDGEN
-------
The last module, the UUID generator, requires a program that you'll
find along with mozbot in CVS. You may have this already. If you
don't, then here's how I got my copy:
<ianh:~/mozbot/resources> export CVSROOT=:pserver:anonymous@cvs-mirror.mozilla.org:/cvsroot
<ianh:~/mozbot/resources> cvs login
The password is 'anonymous'.
<ianh:~/mozbot/resources> cvs checkout mozilla/webtools/mozbot/uuidgen
<ianh:~/mozbot/resources> cd mozilla/webtools/mozbot/uuidgen/
<ianh:~/mozbot/resources/mozilla/webtools/mozbot/uuidgen> make
<ianh:~/mozbot/resources/mozilla/webtools/mozbot/uuidgen> cp uuidgen ../../../../../bin
<ianh:~/mozbot/resources/mozilla/webtools/mozbot/uuidgen> cd ../../../../../
At this point I think I had all the required programs.
MORE THOROUGH CONFIGURATION
---------------------------
Now that I'm ready to run mozbot chroot()ed, it is time to make the
final preparations. Firts, I moved the resources directory out of the
way, since I had finished with it:
<ianh:~/mozbot> mv resources ../installed-resources
Next I made sure all the rights were set to read-only for people other
than the user:
<ianh:~/mozbot> chmod -R go-w .
At this point I wanted to make sure the bot started ok, so I ran the
run-mozbot-chrooted script:
<ianh:~/mozbot> ./run-mozbot-chrooted
That worked. I changed the script to:
export PATH=/bin
./mozbot.pl --chroot /config/default
What's this 'config' thing? Well, since we're about to chown() all the
files to root and then setuid the script to nobody, the bot wouldn't
be able to edit the config file if it was in the same directory as the
source -- so I created a new directory with no rights restrictions,
and moved the configuration file into it:
<ianh:~/mozbot> mkdir config
<ianh:~/mozbot> mv mozbot.pl.cfg config/default
<ianh:~/mozbot> chmod ugo=rwx config
<ianh:~/mozbot> chmod ugo=rw config/default
In order to not have to change all the perl scripts, I gave them a
fake 'mozbot' directory:
<ianh:~/mozbot> mkdir u
<ianh:~/mozbot> mkdir u/ianh
<ianh:~/mozbot> cd u/ianh
<ianh:~/mozbot/u/ianh> ln -s / mozbot
<ianh:~/mozbot/u/ianh> cd ../../
At this point I ran 'su' to drop down to a root shell. Be careful!
I had to copy several library files to a usr/lib directory. To do
this, the 'truss' and 'ldd' tools came in very useful. In particular,
I used 'truss' to watch what calls mozbot was attempting, and 'ldd' to
find what modules dependencies Perl, wget, and the modules had.
Credit should be given to Pavlov for actually doing most of this for
me... I didn't even know 'ldd' existed until he showed me. ;-)
Here is the list of the modules I copied:
usr/lib:
ld.so.1 libdl.so.1 libgen.so.1 libmp.so.2
libresolv.so.1 libsec.so.1 nscd_nischeck nss_files.so.1
libc.so.1 libdoor.so.1 libld.so.2 libnsl.so.1
libresolv.so.2 libsocket.so.1 nss_compat.so.1 nss_nis.so.1
libcrypt_i.so.1 libelf.so.1 liblddbg.so.4 libpthread.so.1
librtld.so.1 libthread.so.1 nss_dns.so.1 nss_nisplus.so.1
usr/platform/SUNW,Ultra-60:
libc_psr.so.1
You may not need all of these.
I also had to copy /dev/null, /dev/zero, /dev/tcp, /dev/ticotsord and
/dev/udp into a new dev/ directory (hint: use 'tar' to copy devices,
it won't work if you try to do it with 'cp'). I may not have needed
all of these (this was slightly complicated by the fact that on
Solaris the /dev devices are symlinks; I used 'tar' to copy the real
devices from /devices and renamed them when I extracted the tarball):
total 4
drwxrwxr-x 2 root other 512 Mar 30 14:34 .
drwxr-xr-x 16 root staff 512 Mar 30 15:47 ..
crw-rw-r-- 1 root sys 13, 2 Mar 30 14:25 null
crw-rw-rw- 1 root sys 11, 42 Jun 6 2000 tcp
crw-rw-rw- 1 root sys 105, 1 Jun 6 2000 ticotsord
crw-rw-rw- 1 root sys 11, 41 Jun 6 2000 udp
crw-rw-r-- 1 root sys 13, 12 Jun 6 2000 zero
I had to copy several files from /etc into a new 'etc' directory, in
particular:
etc:
group hosts netconfig nsswitch.conf
passwd protocols resolv.conf wgetrc
You may wish to sanitize your 'passwd' file. For the nsswitch.conf
file you should use the 'nsswitch.dns' file (if you have one) -- make
sure the DNS line is 'dns files' and not 'files dns'. (Profuse thanks
go to rfm from Sun who helped me with this.)
Now I used 'chown' to make every file in /u/ianh/mozbot/ be owned by
root, except the config directory. I also edited 'mozbot.pl' to ensure
that the correct arguments were passed to 'setuid' and 'setgid' --
search for 'setuid' in the source to find the right place.
With that all set up, I finally could run the bot safe in the
knowledge that it was relatively secure:
<root:/u/ianh/mozbot> ./run-mozbot-chrooted
I hope this has helped you in some way!!!
-- end --

15
webtools/mozbot/INSTALL.WIN32 Normal file
View File

@ -0,0 +1,15 @@
_ _
m o z i l l a |.| o r g | |
_ __ ___ ___ ___| |__ ___ | |_
| '_ ` _ \ / _ \_ / '_ \ / _ \| __|
| | | | | | (_) / /| |_) | (_) | |_
|_| |_| |_|\___/___|_.__/ \___/ \__|
=======================- 2 . 0 -==
INTRODUCTION
------------
Forget it.
-- end --

4
webtools/mozbot/README
View File

@ -1,2 +1,2 @@
This is the source code for the "mozbot" robot that hangs out on the #mozilla
irc channel (server irc.mozilla.org).
This is the source code for "mozbot", the IRC bot who hangs out in the
#mozilla channel at irc.mozilla.org.

101
webtools/mozbot/Tinderbox.pm
View File

@ -1,101 +0,0 @@
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Mozilla Public
# License Version 1.1 (the "License"); you may not use this file
# except in compliance with the License. You may obtain a copy of
# the License at http://www.mozilla.org/MPL/
#
# Software distributed under the License is distributed on an "AS
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
# implied. See the License for the specific language governing
# rights and limitations under the License.
#
# The Original Code is the Bugzilla Bug Tracking System.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are
# Copyright (C) 1998 Netscape Communications Corporation. All
# Rights Reserved.
#
# Contributor(s): Harrison Page <harrison@netscape.com>
# Terry Weissman <terry@mozilla.org>
# harrison@netscape.com
#
# 1.0 10/16/98
package Tinderbox;
require Exporter;
use strict 'vars';
use vars qw (@ISA @EXPORT $VERSION);
use LWP::Simple;
# use HTML::Parse;
use Carp;
@ISA = qw (Exporter);
@EXPORT = qw (status statuz);
my $VERSION = "1.0";
# status wants a reference to a list of tinderbox trees
# and a url ending with tree=, default to mozilla.org's
# server if not provided. status returns two references
# to hashes. the first contains tree names as key,
# tree status as value. second hash contains trees to
# whether or tree is open or closed.
#
# tree status can be horked or success.
#
# barf.
sub status
{
my $trees = shift;
my $url = shift;
my %info; my %tree_state;
# maybe this is too helpful
if (ref ($trees) ne "ARRAY")
{
carp "status method wants a reference to a list, not a " . ref ($trees);
return;
}
$url = $url || "http://tinderbox.mozilla.org/" .
"showbuilds.cgi?quickparse=1&tree=";
my $output = get $url . join ',', @$trees;
return if (! $output);
my @qp = split /\n/, $output;
# loop through quickparse output
foreach my $op (@qp)
{
my ($type, $tree, $build, $state) = split /\|/, $op;
if ($type eq "State")
{
$tree_state{$tree} = $state;
}
elsif ($type eq "Build")
{
if ($state =~ /success/i) {
$state = "Success";
} elsif ($state =~ /testfailed/i) {
$state = "Test Failed";
} else {
$state = "Horked";
}
$info{$tree}{$build} = $state;
}
}
return (\%info, \%tree_state);
}
1;

160
webtools/mozbot/babel.pm
View File

@ -1,160 +0,0 @@
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Mozilla Public
# License Version 1.1 (the "License"); you may not use this file
# except in compliance with the License. You may obtain a copy of
# the License at http://www.mozilla.org/MPL/
#
# Software distributed under the License is distributed on an "AS
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
# implied. See the License for the specific language governing
# rights and limitations under the License.
#
# The Original Code is the Bugzilla Bug Tracking System.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are
# Copyright (C) 1998 Netscape Communications Corporation. All
# Rights Reserved.
#
# Contributor(s): Terry Weissman <terry@mozilla.org>
#
#
#
# Most of this module is rudely swiped from infobot. Here are the various
# licensing words I found with it:
# --
#
# The license for this stuff is yet to be written.
# Please don't do anything good with it without at
# least mentioning this work, perhaps the author (Kevin
# Lenzo, lenzo@cs.cmu.edu), and the Carnegie Mellon
# University, which supports my study.
#
# Also, there is work being done on various bits of this
# now by various people; if you have any corrections
# or contributions, please send them to me. Flat
# ascii files of databases, made with dump_db, are
# wonderful things to share, and a repository will be
# set up.
#
# ---
#
# 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.
#
# ---------------------- (End of licensing words) ------------------------
package babel;
use strict;
use diagnostics;
my $no_babel;
BEGIN {
eval "use URI::Escape"; # utility functions for encoding the
if ($@) { $no_babel++}; # babelfish request
eval "use LWP::UserAgent";
if ($@) { $no_babel++};
}
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 {
return '' if $no_babel;
my ($direction, $lang, $phrase) = @_;
$lang = $lang_code{$lang};
my $ua = new LWP::UserAgent;
$ua->timeout(4);
my $req =
HTTP::Request->new('POST',
'http://babelfish.altavista.digital.com/cgi-bin/translate');
$req->content_type('application/x-www-form-urlencoded');
my $tolang = "en_$lang";
my $toenglish = "${lang}_en";
if ($direction eq 'to') {
return translate($phrase, $tolang, $req, $ua);
}
elsif ($direction eq 'from') {
return translate($phrase, $toenglish, $req, $ua);
}
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);
}
return $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);
if ($res->is_success) {
my $html = $res->content;
# This method subject to change with the whims of Altavista's design
# staff.
my ($translated) =
($html =~ m{<br>
\s+
<font\ face="arial,\ helvetica">
\s*
(?:\*\*\s+time\ out\s+\*\*)?
\s*
([^<]*)
}sx);
$translated =~ s/\n/ /g;
$translated =~ s/\s*$//;
return $translated;
} else {
return ":("; # failure
}
}
"Hello. I'm a true value.";

130
webtools/mozbot/config/sample Normal file
View File

@ -0,0 +1,130 @@
connectTimeout=120
helpline=see http://www.mozilla.org/projects/mozbot/
sleep=60
throttleTime=2.2
Admin::files=lib/Configuration.pm
Admin::files=lib/Mails.pm
Admin::files=mozbot.pl
Admin::files=lib/IO/SecurePipe.pm
Bugzilla::ignoreCommentsFrom=|
FortuneCookies::bakingTime=20
FortuneCookies::cookies=* UNIX is a Trademark of Bell Laboratories.
FortuneCookies::cookies=/earth is 98% full ... please delete anyone you can.
FortuneCookies::cookies=A man is not complete until he is married -- then he is finished.
FortuneCookies::cookies=A man with his hands in pockets feels foolish, but a man with holes in pockets feels nuts.
FortuneCookies::cookies=A meeting is an event at which the minutes are kept and the hours are lost.
FortuneCookies::cookies=A modem is a baudy house.
FortuneCookies::cookies=A thunderstorm in .nl here can startle a butterfly in .au
FortuneCookies::cookies=Anyone can make an omelet with eggs. The trick is to make one with none.
FortuneCookies::cookies=Best of all is never to have been born. Second best is to die soon.
FortuneCookies::cookies=Better to sleep with chicken than to choke it.
FortuneCookies::cookies=Confession is good for the soul, but bad for the career.
FortuneCookies::cookies=Confucius not: know what to say!
FortuneCookies::cookies=Confucius say: "Is more to running BBS than finding ON.
FortuneCookies::cookies=Confucius say: A bird in hand makes hard to blow nose.
FortuneCookies::cookies=Confucius say: Baby conceived in automatic car shiftless bastard.
FortuneCookies::cookies=Confucius say: I didn't say that!
FortuneCookies::cookies=Confucius say: Is stuffy inside fortune cookie.
FortuneCookies::cookies=Confucius say: Man who Farts in Church sits in own pew.
FortuneCookies::cookies=Confucius say: Man who pull out too fast leave rubber.
FortuneCookies::cookies=Confucius say: Man who stand on toilet is high on pot.
FortuneCookies::cookies=Confucius say: Man with hand in pocket is having a ball.
FortuneCookies::cookies=Confucius say: Man with no legs bums around.
FortuneCookies::cookies=Confucius say: Put Rooster in Freezer Get A Stiff Cock.
FortuneCookies::cookies=Confucius say: Shit happens.
FortuneCookies::cookies=Confucius say: Show off always shown up in showdown.
FortuneCookies::cookies=Confucius say: Woman who cook carrots and peas in same pot not sanitary!
FortuneCookies::cookies=Confucius say: `A Watched Tandy Never Boots!
FortuneCookies::cookies=Confucius say: man who smoke pot choke on handle.
FortuneCookies::cookies=Confucius say: nothing - Because he's dead!
FortuneCookies::cookies=Confucius say: too damn much!
FortuneCookies::cookies=Death is nature's way of telling you to slow down.
FortuneCookies::cookies=Debug is human, de-fix divine.
FortuneCookies::cookies=Despite all appearances, your boss is a thinking, feeling, human being.
FortuneCookies::cookies=Do not drink coffee in early A.M. It will keep you awake until noon.
FortuneCookies::cookies=Do not simplify the design of a program if a way can be found to make it complex and wonderful.
FortuneCookies::cookies=Due to lack of disk space, this fortune database has been discontinued.
FortuneCookies::cookies=Early to bed and early to rise and you'll be groggy when everyone else is wide awake.
FortuneCookies::cookies=Every path has its puddle.
FortuneCookies::cookies=Everything that you know is wrong, but you can be straightened out.
FortuneCookies::cookies=Experience is the worst teacher. It always gives the test first and the instruction afterward.
FortuneCookies::cookies=Future looks spotty. You will spill soup in late evening.
FortuneCookies::cookies=God made machine language; all the rest is the work of man.
FortuneCookies::cookies=He that teaches himself has a fool for a master.
FortuneCookies::cookies=He who crosses the ocean twice without washing is a dirty double crosser.
FortuneCookies::cookies=He who has a shady past knows that nice guys finish last.
FortuneCookies::cookies=History repeats itself. That's one thing wrong with history.
FortuneCookies::cookies=Hope that the day after you die is a nice day.
FortuneCookies::cookies=House without toilet is uncanny.
FortuneCookies::cookies=I have a theory that it's impossible to prove anything, but I can't prove it.
FortuneCookies::cookies=I know you're in search of yourself, I just haven't seen you anywhere.
FortuneCookies::cookies=If at first you don't succeed, redefine success.
FortuneCookies::cookies=If life isn't what you wanted, have you asked for anything else?
FortuneCookies::cookies=If this fortune didn't exist, somebody would have invented it.
FortuneCookies::cookies=If we meet a man of rare intellect, we should ask him what book he reads.
FortuneCookies::cookies=If you are too busy to read, then you are too busy.
FortuneCookies::cookies=If you do something right once, someone will ask you to do it again.
FortuneCookies::cookies=If you park, don't drink, accidents cause people.
FortuneCookies::cookies=If your aim in life is nothing, you can't miss.
FortuneCookies::cookies=In English, every word can be verbed. Would that it were so in our programming languages.
FortuneCookies::cookies=In an orderly world, there's always a place for the disorderly.
FortuneCookies::cookies=In the force if Yoda's so strong, construct a sentence with words in the proper order then why can't he?
FortuneCookies::cookies=It is not well to be thought of as one who meekly submits to insolence and intimidation.
FortuneCookies::cookies=It is very difficult to prophesy, especially when it pertains to the future.
FortuneCookies::cookies=Life is too short to be taken seriously.
FortuneCookies::cookies=Logic is a systematic method of coming to the wrong conclusion with confidence.
FortuneCookies::cookies=Ma Bell is a mean mother!
FortuneCookies::cookies=Man who arrives at party two hours late will find he has been beaten to the punch.
FortuneCookies::cookies=Man who eat many prunes, sit on toilet many moons.
FortuneCookies::cookies=Man who fight with wife all day, get no peace at night!
FortuneCookies::cookies=Man who put head on Rail Road track to listen for train likely to end up with sudden splitting headache.
FortuneCookies::cookies=May all your PUSHes be POPped.
FortuneCookies::cookies=Measure with a micrometer. Mark with chalk. Cut with an axe.
FortuneCookies::cookies=Message will arrive in the mail. Destroy, before the FBI sees it.
FortuneCookies::cookies=Never trust a computer you can't repair yourself.
FortuneCookies::cookies=Never underestimate the power of human stupidity.
FortuneCookies::cookies=No matter what happens, there is always someone who knew it would.
FortuneCookies::cookies=Nondeterminism means never having to say you are wrong.
FortuneCookies::cookies=On the eighth day, God created FORTRAN.
FortuneCookies::cookies=One person's error is another person's data.
FortuneCookies::cookies=One possible reason that things aren't going according to plan is that there never was a plan in the first place.
FortuneCookies::cookies=One seldom sees a monument to a committee.
FortuneCookies::cookies=Others can stop you temporarily, only you can do it permanently.
FortuneCookies::cookies=Overflow on /dev/null, please empty the bit bucket.
FortuneCookies::cookies=Passwords are implemented as a result of insecurity.
FortuneCookies::cookies=Pause for storage relocation.
FortuneCookies::cookies=Pretend to spank me -- I'm a pseudo-masochist!
FortuneCookies::cookies=Quantity is no substitute for quality, but its the only one we've got.
FortuneCookies::cookies=Real computer scientists don't comment their code. The identifiers are so long they can't afford the disk space.
FortuneCookies::cookies=Recursion is the root of computation since it trades description for time.
FortuneCookies::cookies=Standards are crucial. And the best thing about standards is: there are so many to choose from!
FortuneCookies::cookies=The first version always gets thrown away.
FortuneCookies::cookies=The important thing is not to stop questioning.
FortuneCookies::cookies=The light of a hundred stars does not equal the light of the moon.
FortuneCookies::cookies=The meek shall inherit the earth; the rest of us will go to the stars.
FortuneCookies::cookies=The more you sweat in peace, the less you bleed in war.
FortuneCookies::cookies=The most important early product on the way to developing a good product is an imperfect version.
FortuneCookies::cookies=The number of feet in a yard is directly proportional to the success of the barbecue.
FortuneCookies::cookies=The only person who always got his work done by Friday was Robinson Crusoe.
FortuneCookies::cookies=The sun will rise in the east today, indicating nothing in particular.
FortuneCookies::cookies=The trouble with computers is that they do what you tell them, not what you want.
FortuneCookies::cookies=There are two ways to write error-free programs; only the third one works.
FortuneCookies::cookies=This life is yours. Some of it was given to you; the rest, you made yourself.
FortuneCookies::cookies=This system will self-destruct in five minutes.
FortuneCookies::cookies=This will be a memorable month -- no matter how hard you try to forget it.
FortuneCookies::cookies=Those who do not understand Unix are condemned to reinvent it, poorly.
FortuneCookies::cookies=Those who smile bring light to others
FortuneCookies::cookies=Tomorrow will be cancelled due to lack of interest.
FortuneCookies::cookies=War doesn't determine who's right, war determines who's left.
FortuneCookies::cookies=War is peace. Freedom is slavery. Ketchup is a vegetable.
FortuneCookies::cookies=We promise according to our hopes, and perform according to our fears.
FortuneCookies::cookies=Wife who put husband in doghouse soon find him in cat house.
FortuneCookies::cookies=You can always tell the people that are forging the new frontier. They're the ones with arrows sticking out of their backs.
FortuneCookies::cookies=You have many friends and very few living enemies.
FortuneCookies::cookies=You may attend a party where strange customs prevail.
FortuneCookies::cookies=You might have mail.
FortuneCookies::cookies=You will be advanced socially, without any special effort on your part.
FortuneCookies::cookies=You're currently going through a difficult transition period called "Life."
FortuneCookies::cookies=panic: kernel segmentation violation. core dumped (only kidding)
FortuneCookies::cookiesIndex=38
FortuneCookies::cookiesMax=10

183
webtools/mozbot/lib/Configuration.pm Normal file
View File

@ -0,0 +1,183 @@
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Mozilla Public
# License Version 1.1 (the "License"); you may not use this file
# except in compliance with the License. You may obtain a copy of
# the License at http://www.mozilla.org/MPL/
#
# Software distributed under the License is distributed on an "AS
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
# implied. See the License for the specific language governing
# rights and limitations under the License.
#
# The Original Code is the Bugzilla Bug Tracking System.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are
# Copyright (C) 1998 Netscape Communications Corporation. All
# Rights Reserved.
#
# Contributor(s): Harrison Page <harrison@netscape.com>
# Terry Weissman <terry@mozilla.org>
# Ian Hickson <py8ieh=mozbot@bath.ac.uk>
package Configuration;
use strict;
use Carp;
sub Get {
my ($file, $config) = @_;
my %seen;
open FILE, "<$file" or return 0;
my $line = 0;
while (<FILE>) {
$line++; chomp;
if (/^ *([^#;][^=\n\r]*)=(.*)$/os) {
my $value = $$config{$1};
if (defined($value)) {
$value = $$value while ref($value) eq 'REF';
if (ref($value) eq 'SCALAR') {
$$value = $2;
} elsif (ref($value) eq 'ARRAY') {
if ($seen{$1}) {
push(@$value, $2);
} else {
@$value = ($2);
}
} elsif (ref($value) eq 'HASH') {
unless ($seen{$1}) {
%$value = ();
}
$2 =~ /^(.)(.*?)\1=>(.*)$/so;
$$value{$2} = $3;
}
} # else unknown variable, ignore
$seen{$1} = 1;
} # else ignore (probably comment)
}
close FILE;
return $line;
}
sub Save {
my ($file, $config) = @_;
local $_;
# Try to keep file structure if possible
my @lines;
if (open FILE, "<$file") {
while (<FILE>) {
push @lines, $_;
}
close FILE;
}
# but make sure we put in all the data (dups are dealt with)
foreach (sort keys %$config) {
push @lines, "$_=";
}
# Open file to which we are saving
open FILE, ">$file.~$$~" or confess("Could not save configuration: $!");
# ok, save file back again
# make sure we only write parameters once by
# keeping a log of those done
my %seen;
foreach (@lines) {
chomp;
if (/^ *([^#;][^=\n\r]*)=(.*)$/os) {
if (defined($$config{$1})) {
unless ($seen{$1}) {
my $value = $$config{$1};
$value = $$value while ref($value) eq 'REF';
if (ref($value) eq 'SCALAR') {
if (defined($$value)) {
print FILE $1.'='.$$value."\n";
}
} elsif (ref($value) eq 'HASH') {
foreach my $item (keys %$value) {
my $data = $$value{$item};
my $delimiter;
foreach ('"','\'','|',':','#','*','<','>','/','[',']','{','}',
'(',')','\\','=','-','@','!','$','%','&',' ','`','~') {
if ($item !~ /\Q$_\E=>/os) {
$delimiter = $_;
last;
}
}
print FILE "$1=$delimiter$item$delimiter=>$data\n" if defined($delimiter);
# else, silent data loss... XXX
}
} elsif (ref($value) eq 'ARRAY') {
foreach my $item (@$value) {
$item = '' unless defined($item);
print FILE "$1=$item\n";
}
} else {
confess("Unsupported data type '".ref($value)."' writing $1 (".$$config{$1}.')');
}
$seen{$1} = 1;
} # else seen it already
} else { # unknown
print FILE "$1=$2\n";
}
} else {
# might be a comment
print FILE $_."\n";
}
}
# actually do make a change to the real file
close FILE;
# -- #mozwebtools was here --
# * Hixie is sad as his bot crashes.
# * Hixie adds in a check to make sure that the file he tries
# to delete actually exists first.
# <timeless> delete??
unlink $file or confess("Could not delete $file: $!") if (-e $file);
rename("$file.~$$~", $file) or confess("Could not rename to $file: $!");
}
sub Ensure {
my ($config) = @_;
my $changed;
foreach (@$config) {
if (ref($$_[1]) eq 'SCALAR') {
unless (defined(${$$_[1]})) {
if (-t) {
print $$_[0]. ' ';
<> =~ /^(.*)$/os;
${$$_[1]} = $1;
${$$_[1]} = '' unless defined ${$$_[1]};
chomp(${$$_[1]});
$changed++;
} else {
confess("Terminal is not interactive, so could not ask '$$_[0]'. Gave up");
}
}
} elsif (ref($$_[1]) eq 'ARRAY') {
unless (defined(@{$$_[1]})) {
if (-t) {
print $$_[0]. " (enter a blank line to finish)\n";
my $input;
do {
$input = <>;
$input = '' unless defined $input;
chomp($input);
push @{$$_[1]}, $input if $input;
$changed++;
} while $input;
} else {
confess("Terminal is not interactive, so could not ask '$$_[0]'. Gave up");
}
}
} else {
confess("Unsupported data type expected for question '$$_[0]'");
}
}
return $changed;
}
1; # end

66
webtools/mozbot/lib/IO/SecurePipe.pm Normal file
View File

@ -0,0 +1,66 @@
# IO::SecurePipe.pm
# Created by Ian Hickson to make exec() call if IO::Pipe more secure.
# Distributed under exactly the same licence terms as IO::Pipe.
package IO::SecurePipe;
use strict;
#use Carp;
use IO::Pipe;
use vars qw(@ISA);
@ISA = qw(IO::Pipe);
my $do_spawn = $^O eq 'os2';
sub croak {
exec $0 ($0, 'ABORT'); # do not call shutdown handlers
exit(); # exit (implicit in exec() actually)
}
sub _doit {
my $me = shift;
my $rw = shift;
my $pid = $do_spawn ? 0 : fork();
if($pid) { # Parent
return $pid;
}
elsif(defined $pid) { # Child or spawn
my $fh;
my $io = $rw ? \*STDIN : \*STDOUT;
my ($mode, $save) = $rw ? "r" : "w";
if ($do_spawn) {
require Fcntl;
$save = IO::Handle->new_from_fd($io, $mode);
# Close in child:
fcntl(shift, Fcntl::F_SETFD(), 1) or croak "fcntl: $!";
$fh = $rw ? ${*$me}[0] : ${*$me}[1];
} else {
shift;
$fh = $rw ? $me->reader() : $me->writer(); # close the other end
}
bless $io, "IO::Handle";
$io->fdopen($fh, $mode);
$fh->close;
if ($do_spawn) {
$pid = eval { system 1, @_ }; # 1 == P_NOWAIT
my $err = $!;
$io->fdopen($save, $mode);
$save->close or croak "Cannot close $!";
croak "IO::Pipe: Cannot spawn-NOWAIT: $err" if not $pid or $pid < 0;
return $pid;
} else {
exec { $_[0] } @_ or # XXX change here
croak "IO::Pipe: Cannot exec: $!";
}
}
else {
croak "IO::Pipe: Cannot fork: $!";
}
# NOT Reached
}
1;

179
webtools/mozbot/lib/Mails.pm Normal file
View File

@ -0,0 +1,179 @@
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Mozilla Public
# License Version 1.1 (the "License"); you may not use this file
# except in compliance with the License. You may obtain a copy of
# the License at http://www.mozilla.org/MPL/
#
# Software distributed under the License is distributed on an "AS
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
# implied. See the License for the specific language governing
# rights and limitations under the License.
#
# The Original Code is the Bugzilla Bug Tracking System.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are
# Copyright (C) 1998 Netscape Communications Corporation. All
# Rights Reserved.
#
# Contributor(s): Harrison Page <harrison@netscape.com>
# Terry Weissman <terry@mozilla.org>
# Ian Hickson <py8ieh=mozbot@bath.ac.uk>
package Mails;
use strict;
use Carp;
# User must declare the following package global variables:
# $Mails::owner = \'e-mail address of owner';
# $Mails::smtphost = 'name of SMTP server';
# $Mails::debug = \&function to print debug messages # better solutions welcome
# send mail to the owner
sub mailowner {
my ($subject, $text) = @_;
&$Mails::debug('I am going to mail the owner!!!');
return &sendmail($$Mails::owner, $0, $subject, $text);
}
sub RFC822time {
# Returns today's date as an RFC822 compliant string with the
# exception that the year is returned as four digits. In my
# extremely valuable opinion RFC822 was wrong to specify the year
# as two digits. Many email systems generate four-digit years.
# Today is defined as the first parameter, if given, or else the
# value that time() gives.
my ($tsec,$tmin,$thour,$tmday,$tmon,$tyear,$twday,$tyday,$tisdst) = gmtime(shift || time());
$tyear += 1900; # as mentioned above, this is not RFC822 compliant, but is Y2K-safe.
$tsec = "0$tsec" if $tsec < 10;
$tmin = "0$tmin" if $tmin < 10;
$thour = "0$thour" if $thour < 10;
$tmon = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec')[$tmon];
$twday = ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat')[$twday];
return "$twday, $tmday $tmon $tyear $thour:$tmin:$tsec GMT";
}
sub sendmail {
my ($to, $from, $subject, $text, $sig) = (@_, $0);
eval {
use Net::SMTP;
my $date = &RFC822time();
my $smtp = Net::SMTP->new($Mails::smtphost) or confess("Could not create SMTP connection to $Mails::smtphost! Giving Up");
$smtp->mail($ENV{USER}); # XXX ?
$smtp->to($to);
$smtp->data(<<end);
X-Mailer: $0, Mails.pm; $$Mails::owner
To: $to
From: $from
Subject: $subject
Date: $date
$text
--
$sig
end
$smtp->quit;
} or do {
&$Mails::debug('Failed to send e-mail.');
&$Mails::debug($@);
&$Mails::debug('-'x40);
&$Mails::debug("To: $to");
&$Mails::debug("From: $from");
&$Mails::debug("Subject: $subject");
&$Mails::debug("\n$text\n-- \n$sig");
&$Mails::debug('-'x40);
return 0;
};
return 1;
}
##########################################################
#### The Mails ##########################################
##########################################################
sub ServerDown {
my ($server, $port, $nick, $ircname, $username) = @_;
return &mailowner("Help! I can't talk to $server:$port!", <<end);
Hello Sir or Madam!
I'm afraid I could not connect to the IRC server. I tried, and will
try and try again (unless you kill me...) but it was fruitless.
Could you kick the IRC server for me? Give it a right ol' booting.
And hit the network connection while you are at it, would you please?
Thanks.
Here is what I was trying to connect to:
Server: $server
Port: $port
Nick: $nick
Ircname: $ircname
Username: $username
Hope that helps.
Cheers,
end
}
sub ServerUp {
my ($server) = @_;
return &mailowner("Woohoo! $server let me in!", <<end);
Helo again.
You'll be happy to know that everything turned out for the better.
Seeya later,
end
}
sub NickShortage {
my ($cfgfile, $hostname, $port, $username, $ircname, @nicks) = @_;
local $" = "\n ";
return &mailowner('There is a nick shortage!', <<end);
Hello Sir or Madam.
I could not find an unused nick on IRC.
I tried all of these:
@nicks
If you like you could add some more nicks manually by
editing my configuration file, "$cfgfile"... *hint* *hint*
Here is what I think I am connected to:
Hostname: $hostname
Port: $port
Username: $username
IRC Name: $ircname
I'll e-mail you again when I manage to get on.
Seeya,
end
}
sub NickOk {
my ($nick) = @_;
return &mailowner("It's ok, I'm now using $nick as my nick.", <<end);
Hello again.
You'll be happy to know that everything turned out for the better.
Seeya later,
end
}
1; # end

3587
webtools/mozbot/mozbot.pl
View File

File diff suppressed because it is too large Load Diff

5
webtools/mozbot/run-mozbot-chrooted Normal file
View File

@ -0,0 +1,5 @@
export PATH=/bin
./mozbot.pl --chroot /config/default
# NOTE. This file requires that you follow the steps described in the
# included INSTALL file.