diff --git a/mozilla/webtools/mozbot/BotModules/Bugzilla.bm b/mozilla/webtools/mozbot/BotModules/Bugzilla.bm new file mode 100644 index 00000000000..fe8ecac6c9d --- /dev/null +++ b/mozilla/webtools/mozbot/BotModules/Bugzilla.bm @@ -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: \' bugs\' e.g. \'mozbot bugs\'.' + ); + if ($self->isAdmin($event)) { + $commands{'mute'} = 'Disable watching for bug numbers in a channel. Syntax: mute bugzilla in '; + $commands{'unmute'} = 'Enable watching for bug numbers in a channel. Syntax: unmute bugzilla in '; + } + 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 !~ //osi); # if we got truncated, then this will be missing + $output =~ s/<\/TABLE><\/TH>//gosi; + (undef, $output) = split(/Summary<\/A><\/TH>/osi, $output); + ($output, undef) = split(/<\/TABLE>/osi, $output); + $output =~ s/[\n\r]//gosi; + @qp = split(/
/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|\1 (.*?)(.*?)(.*?)(.*?)(.*?)(.*?)(.*)|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; +} + diff --git a/mozilla/webtools/mozbot/BotModules/COPYING b/mozilla/webtools/mozbot/BotModules/COPYING new file mode 100644 index 00000000000..ebe285e28df --- /dev/null +++ b/mozilla/webtools/mozbot/BotModules/COPYING @@ -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 + Terry Weissman + Risto Kotalampi + Josh Soref + Ian Hickson diff --git a/mozilla/webtools/mozbot/BotModules/FTP.bm b/mozilla/webtools/mozbot/BotModules/FTP.bm new file mode 100644 index 00000000000..4862e299883 --- /dev/null +++ b/mozilla/webtools/mozbot/BotModules/FTP.bm @@ -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 '; + $commands{'unmute'} = 'Enable reporting of new files in a channel. Syntax: unmute ftp in '; + } + 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||''; + $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 '>' + ''; + } + } + + + # 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; + +} diff --git a/mozilla/webtools/mozbot/BotModules/Filter.bm b/mozilla/webtools/mozbot/BotModules/Filter.bm new file mode 100644 index 00000000000..37dac783903 --- /dev/null +++ b/mozilla/webtools/mozbot/BotModules/Filter.bm @@ -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: $_ "; + } + if ($self->isAdmin($event)) { + $reply->{'filtersay'} = "Pass text through a filter and send it to a channel. Syntax: filtersay "; + } + 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(@_); + } +} diff --git a/mozilla/webtools/mozbot/BotModules/FortuneCookies.bm b/mozilla/webtools/mozbot/BotModules/FortuneCookies.bm new file mode 100644 index 00000000000..cd0e756f06a --- /dev/null +++ b/mozilla/webtools/mozbot/BotModules/FortuneCookies.bm @@ -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 \' will add each line in 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(@_); + } +} diff --git a/mozilla/webtools/mozbot/BotModules/God.bm b/mozilla/webtools/mozbot/BotModules/God.bm new file mode 100644 index 00000000000..e1002ba8dad --- /dev/null +++ b/mozilla/webtools/mozbot/BotModules/God.bm @@ -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 \'', + '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 in \' to add and \'remove mask in \' 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 in \'', + 'deautoop' => 'Remove someone from the autoop list for a channel. Only bot and channel admins can do this. Syntax: \'deop in \'', + 'enable' => 'Enable a module in a channel. Only bot and channel admins can do this. Syntax: \'enable in \'', + 'disable' => 'Disable a module in a channel. Only bot and channel admins can do this. Syntax: \'disable in \'', + }; + if ($self->isAdmin($event)) { + $answer->{'opme'} .= '. As an administrator, you can also say \'op me in \' 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 in \'', + $answer->{'demote'} = 'Remove someone from the channel admin list for a channel. Only bot admins can do this. Syntax: \'demote in \'', + } + 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 \' in \'."); + + # 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'}: $_"); + } + } +} diff --git a/mozilla/webtools/mozbot/BotModules/Greeting.bm b/mozilla/webtools/mozbot/BotModules/Greeting.bm new file mode 100644 index 00000000000..d7206b79060 --- /dev/null +++ b/mozilla/webtools/mozbot/BotModules/Greeting.bm @@ -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; +} diff --git a/mozilla/webtools/mozbot/BotModules/HelloWorld.bm b/mozilla/webtools/mozbot/BotModules/HelloWorld.bm new file mode 100644 index 00000000000..9c3297d3bb8 --- /dev/null +++ b/mozilla/webtools/mozbot/BotModules/HelloWorld.bm @@ -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. +} + diff --git a/mozilla/webtools/mozbot/BotModules/KeepAlive.bm b/mozilla/webtools/mozbot/BotModules/KeepAlive.bm new file mode 100644 index 00000000000..6cf0af1d29f --- /dev/null +++ b/mozilla/webtools/mozbot/BotModules/KeepAlive.bm @@ -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); + } +} diff --git a/mozilla/webtools/mozbot/BotModules/MiniLogger.bm b/mozilla/webtools/mozbot/BotModules/MiniLogger.bm new file mode 100644 index 00000000000..c9f7f08d434 --- /dev/null +++ b/mozilla/webtools/mozbot/BotModules/MiniLogger.bm @@ -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 \' 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 -> [ text] + ['bufferSize', 1, 1, 20], # number of comments to remember, per channel/pattern combination + ['patterns', 1, 1, {'uris'=>'"]+>?'}], # 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.'); +} diff --git a/mozilla/webtools/mozbot/BotModules/Parrot.bm b/mozilla/webtools/mozbot/BotModules/Parrot.bm new file mode 100644 index 00000000000..0f7c665d697 --- /dev/null +++ b/mozilla/webtools/mozbot/BotModules/Parrot.bm @@ -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 can be a person or channel. Syntax: say ', + 'do' => 'Makes the bot do (/me) something. The can be a person or channel. Syntax: do ', + 'invite' => 'Makes the bot invite (/invite) somebody to a channel. Syntax: invite ', + 'announce' => 'Makes the bot announce something to every channel in which this module is enabled. Syntax: announce ', + }; + } 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. +} + diff --git a/mozilla/webtools/mozbot/BotModules/RDF.bm b/mozilla/webtools/mozbot/BotModules/RDF.bm new file mode 100644 index 00000000000..f9bfaf72e35 --- /dev/null +++ b/mozilla/webtools/mozbot/BotModules/RDF.bm @@ -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 in '; + $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 in '; + } 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 -- + # anyway, $self->{'data'}->{$self->{'sites'}->{$site}}->{'title'} is + # another nice piece of perl (embedded in a quoted string in this case) + # yeah, that's a bit more familiar + # Oooh, nice one + # Reminds me of Java, a bit :-) + # Without all the casting about from Object to Hashtable + # all this, BTW, is from the RDF module (the one that mozbot uses to + # report changes in mozillazine and so on) + # I still tend to comment these things a bit just for maintainability + # by others who might not wish to do mental gymnastics :) + # :-) + + } 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>/osi) { + $channelpart = $1; + } + + # remove any image related stuff + $output =~ s/.*<\/image>//gosi; + + # get the channel title + $self->{'data'}->{$uri}->{'title'} = $uri; + if ($channelpart =~ /\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, $_); + } + } +} diff --git a/mozilla/webtools/mozbot/BotModules/Rude.bm b/mozilla/webtools/mozbot/BotModules/Rude.bm new file mode 100644 index 00000000000..b74602e3204 --- /dev/null +++ b/mozilla/webtools/mozbot/BotModules/Rude.bm @@ -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. +} diff --git a/mozilla/webtools/mozbot/BotModules/Sheriff.bm b/mozilla/webtools/mozbot/BotModules/Sheriff.bm new file mode 100644 index 00000000000..2858a22d0d9 --- /dev/null +++ b/mozilla/webtools/mozbot/BotModules/Sheriff.bm @@ -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); + } +} diff --git a/mozilla/webtools/mozbot/BotModules/Tinderbox.bm b/mozilla/webtools/mozbot/BotModules/Tinderbox.bm new file mode 100644 index 00000000000..95b2fb1b903 --- /dev/null +++ b/mozilla/webtools/mozbot/BotModules/Tinderbox.bm @@ -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, $_); + } + } +} diff --git a/mozilla/webtools/mozbot/BotModules/Translate.bm b/mozilla/webtools/mozbot/BotModules/Translate.bm new file mode 100644 index 00000000000..8f49f360f04 --- /dev/null +++ b/mozilla/webtools/mozbot/BotModules/Translate.bm @@ -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', []); + } +} + diff --git a/mozilla/webtools/mozbot/BotModules/UUIDGen.bm b/mozilla/webtools/mozbot/BotModules/UUIDGen.bm new file mode 100644 index 00000000000..f13eed3f15e --- /dev/null +++ b/mozilla/webtools/mozbot/BotModules/UUIDGen.bm @@ -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(@_); + } +} + diff --git a/mozilla/webtools/mozbot/BotModules/WWW.bm b/mozilla/webtools/mozbot/BotModules/WWW.bm new file mode 100644 index 00000000000..5f214069be8 --- /dev/null +++ b/mozilla/webtools/mozbot/BotModules/WWW.bm @@ -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(@_); + } +} diff --git a/mozilla/webtools/mozbot/BotModules/Wishlist.bm b/mozilla/webtools/mozbot/BotModules/Wishlist.bm new file mode 100644 index 00000000000..f39bb74afcb --- /dev/null +++ b/mozilla/webtools/mozbot/BotModules/Wishlist.bm @@ -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. +} diff --git a/mozilla/webtools/mozbot/BotModules/devel.txt b/mozilla/webtools/mozbot/BotModules/devel.txt new file mode 100644 index 00000000000..bf1f0761ad4 --- /dev/null +++ b/mozilla/webtools/mozbot/BotModules/devel.txt @@ -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: + ' => ' + " => " + < => < + > => > + & => & + + 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 -- diff --git a/mozilla/webtools/mozbot/INSTALL b/mozilla/webtools/mozbot/INSTALL new file mode 100644 index 00000000000..bc4a8b7cd24 --- /dev/null +++ b/mozilla/webtools/mozbot/INSTALL @@ -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 -- diff --git a/mozilla/webtools/mozbot/INSTALL.UNIX b/mozilla/webtools/mozbot/INSTALL.UNIX new file mode 100644 index 00000000000..b2af4150065 --- /dev/null +++ b/mozilla/webtools/mozbot/INSTALL.UNIX @@ -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 -- \ No newline at end of file diff --git a/mozilla/webtools/mozbot/INSTALL.WIN32 b/mozilla/webtools/mozbot/INSTALL.WIN32 new file mode 100644 index 00000000000..ad99f0f4013 --- /dev/null +++ b/mozilla/webtools/mozbot/INSTALL.WIN32 @@ -0,0 +1,15 @@ + _ _ + m o z i l l a |.| o r g | | + _ __ ___ ___ ___| |__ ___ | |_ + | '_ ` _ \ / _ \_ / '_ \ / _ \| __| + | | | | | | (_) / /| |_) | (_) | |_ + |_| |_| |_|\___/___|_.__/ \___/ \__| + =======================- 2 . 0 -== + + +INTRODUCTION +------------ + +Forget it. + +-- end -- \ No newline at end of file diff --git a/mozilla/webtools/mozbot/README b/mozilla/webtools/mozbot/README index f31abfcf2c5..f4660b56cb6 100644 --- a/mozilla/webtools/mozbot/README +++ b/mozilla/webtools/mozbot/README @@ -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. diff --git a/mozilla/webtools/mozbot/Tinderbox.pm b/mozilla/webtools/mozbot/Tinderbox.pm deleted file mode 100644 index abb18a42a89..00000000000 --- a/mozilla/webtools/mozbot/Tinderbox.pm +++ /dev/null @@ -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; diff --git a/mozilla/webtools/mozbot/babel.pm b/mozilla/webtools/mozbot/babel.pm deleted file mode 100644 index a6740707873..00000000000 --- a/mozilla/webtools/mozbot/babel.pm +++ /dev/null @@ -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."; diff --git a/mozilla/webtools/mozbot/config/sample b/mozilla/webtools/mozbot/config/sample new file mode 100644 index 00000000000..b56ce28cd9b --- /dev/null +++ b/mozilla/webtools/mozbot/config/sample @@ -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 diff --git a/mozilla/webtools/mozbot/lib/Configuration.pm b/mozilla/webtools/mozbot/lib/Configuration.pm new file mode 100644 index 00000000000..45767b49972 --- /dev/null +++ b/mozilla/webtools/mozbot/lib/Configuration.pm @@ -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 diff --git a/mozilla/webtools/mozbot/lib/IO/SecurePipe.pm b/mozilla/webtools/mozbot/lib/IO/SecurePipe.pm new file mode 100644 index 00000000000..5cf134abc2f --- /dev/null +++ b/mozilla/webtools/mozbot/lib/IO/SecurePipe.pm @@ -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; diff --git a/mozilla/webtools/mozbot/lib/Mails.pm b/mozilla/webtools/mozbot/lib/Mails.pm new file mode 100644 index 00000000000..06d2dc1627e --- /dev/null +++ b/mozilla/webtools/mozbot/lib/Mails.pm @@ -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 diff --git a/mozilla/webtools/mozbot/mozbot.pl b/mozilla/webtools/mozbot/mozbot.pl index f9319265404..494cf855911 100755 --- a/mozilla/webtools/mozbot/mozbot.pl +++ b/mozilla/webtools/mozbot/mozbot.pl @@ -1,5 +1,14 @@ -#!/usr/bonsaitools/bin/perl5 -w +#!/usr/bin/perl -wT # -*- Mode: perl; indent-tabs-mode: nil -*- +# DO NOT REMOVE THE -T ON THE FIRST LINE!!! +# +# _ _ +# m o z i l l a |.| o r g | | +# _ __ ___ ___ ___| |__ ___ | |_ +# | '_ ` _ \ / _ \_ / '_ \ / _ \| __| +# | | | | | | (_) / /| |_) | (_) | |_ +# |_| |_| |_|\___/___|_.__/ \___/ \__| +# =======================- 2 . 0 -== # # The contents of this file are subject to the Mozilla Public # License Version 1.1 (the "License"); you may not use this file @@ -21,14 +30,14 @@ # Contributor(s): Harrison Page <harrison@netscape.com> # Terry Weissman <terry@mozilla.org> # Risto Kotalampi <risto@kotalampi.com> +# Josh Soref <timeless@bemail.org> +# Ian Hickson <mozbot@hixie.ch> # -# mozbot.pl harrison@netscape.com 10/14/98 +# mozbot.pl harrison@netscape.com 1998-10-14 # "irc bot for the gang on #mozilla" # -# features: reports tinderbox status upon request. -# remembers urls. tells you the phase of the moon. -# grabs mozillaZine headlines. fetches slashdot.org -# news. bot will auto-op based on nick and remote host. +# mozbot.pl mozbot@hixie.ch 2000-07-04 +# "irc bot engine for anyone" :-) # # hack on me! required reading: # @@ -39,1228 +48,2646 @@ # # RFC 1459 (Internet Relay Chat Protocol): # http://sunsite.cnlab-switch.ch/ftp/doc/standard/rfc/14xx/1459 +# +# Please file bugs in Bugzilla, under the 'Webtools' product, +# component 'Mozbot'. http://bugzilla.mozilla.org/ + +# TO DO LIST +# XXX Something that checks modules that failed to compile and then +# reloads them when possible +# XXX an HTML entity convertor for things that speak web page contents +# XXX UModeChange +# XXX minor checks +# XXX throttle nick changing and away setting (from module API) +# XXX compile self before run +# XXX parse mode (+o, etc) +# XXX customise gender +# XXX version, source +# XXX optimisations +# XXX ctcp pong +# XXX maybe should catch hangup signal and go to background? +# XXX protect the bot from DOS attacks causing server overload +# XXX protect the server from an overflowing log (add log size limitter +# or rotation) -$SIG{'INT'} = 'killed'; -$SIG{'KILL'} = 'killed'; -$SIG{'TERM'} = 'killed'; +################################ +# Initialisation # +################################ +# -- #mozwebtools was here -- +# <Hixie> syntax error at oopsbot.pl line 48, near "; }" +# <Hixie> Execution of oopsbot.pl aborted due to compilation errors. +# <Hixie> DOH! +# <endico> hee hee. nice smily in the error message + +# catch nasty occurances +$SIG{'INT'} = sub { &killed('INT'); }; +$SIG{'KILL'} = sub { &killed('KILL'); }; +$SIG{'TERM'} = sub { &killed('TERM'); }; +$SIG{'CHLD'} = sub { wait(); }; + +# this allows us to exit() without shutting down (by exec($0)ing) +BEGIN { exit() if ((defined($ARGV[0])) and ($ARGV[0] eq '--abort')); } + +# pragmas use strict; use diagnostics; -use lib "."; -use Net::IRC; -use LWP::Simple; -use Tinderbox; -use Carp; -use Chatbot::Eliza; -use babel; -use IPC::Open2; -use FileHandle; -use Net::FTP; +# chroot if requested +my $CHROOT = 0; +if ((defined($ARGV[0])) and ($ARGV[0] eq '--chroot')) { + # chroot + chroot('.') or die "chroot failed: $!\nAborted"; + # setuid + # This is hardcoded to use user ids and group ids 60001. + # You'll want to change this on your system. + $> = 60001; # setuid nobody + $) = 60001; # setgid nobody + shift(@ARGV); + use lib '/lib'; + $CHROOT = 1; +} elsif ((defined($ARGV[0])) and ($ARGV[0] eq '--assume-chrooted')) { + shift(@ARGV); + use lib '/lib'; + $CHROOT = 1; +} else { + use lib 'lib'; +} + +# important modules +use Net::IRC 0.7; # 0.7 is not backwards compatible with 0.63 for CTCP responses +use IO::SecurePipe; # internal based on IO::Pipe +use IO::Select; +use Carp qw(cluck confess); +use Configuration; # internal +use Mails; # internal + +# Note: Net::SMTP is also used, see the sendmail function in Mails. + +# force flushing $|++; -my $VERSION = "1.65"; # keep me in sync with the mozilla.org cvs repository -my $debug = 1; # debug output also includes warnings, errors +# internal 'constants' +my $NAME = 'mozbot'; +my $VERSION = q$Revision: 1.70 $; +my $USERNAME = "pid-$$"; +my $LOGFILEPREFIX; -my %msgcmds = ( - "url" => \&bot_urls, - "(stocks|stock)" => \&bot_stocks, - ); +# adjust the version constants +$VERSION =~ /([0-9.]+)/; +$VERSION = $1; -my %pubcmds = ( - "(help|about)" => \&bot_about, - "(hi|hello|lo|sup)" => \&bot_hi, - "moon" => \&bot_moon, - "uuid" => \&bot_uuid, - "up" => \&bot_up, - "(trees|tree)" => \&bot_tinderbox, - "debug" => \&bot_debug, - "(stocks|stock)" => \&bot_pub_stocks, - "(translate|xlate|x)" => \&bot_translate, - "review" => \&bot_review, - "approve" => \&bot_approve, - "ftp" => \&ftp_stamp - ); +# variables that should only be changed if you know what you are doing +my $LOGGING = 1; # set to '0' to disable logging +my $LOGFILEDIR; # set this to override the logging output directory -my %admincmds = ( - "bless" => \&bot_bless, - "unbless" => \&bot_unbless, - "shutdown" => \&bot_shutdown, - "say" => \&bot_say, - "list" => \&bot_list, - "ftpx" => \&ftp_check, - "ftpc" => \&ftp_clear - ); - -my %rdfcmds = ( - "(slashdot|sd|\/\.)" => "http://www.slashdot.org/slashdot.rdf", - "(mozillaorg|mozilla|mo)" => "http://www.mozilla.org/news.rdf", - "(newsbot|nb)" => "http://www.mozilla.org/newsbot/newsbot.rdf", - "(xptoolkit|xpfe)" => "http://www.mozilla.org/xpfe/toolkit.rdf", - "(freshmeat|fm)" => "http://freshmeat.net/backend/fm.rdf", - "(mozillazine|zine|mz)" => "http://www.mozillazine.org/contents.rdf", - ); - -my %rdf_title; -my %rdf_link; -my %rdf_last; -my %rdf_items; -my %latestbuilds; -my $ftpscanned = 0; - -@::origargv = @ARGV; - -my $server = shift; -my $port = shift; -my $nick = shift; -my $channel = shift; - -my $stockf = "stocklist"; -my %stocklist = (); -my %stockvals = (); -my %stockhist; - -$server = $server || "irc.mozilla.org"; -$port = $port || "6667"; -$nick = $nick || "mozbot"; -$channel = $channel || "#mozilla"; - -&debug ("mozbot $VERSION starting up"); - -LoadStockList(); - -&create_pid_file; - -# read admin list -my %admins = ( "rko" => "netscape.com", "cyeh" => "netscape.com", "terry" => "netscape.com" ); -my $adminf = ".$nick-admins"; -&fetch_admin_conf (\%admins); - -my $uptime = 0; - -$::moon = "./moon"; -$::moon = (-f $::moon) ? $::moon : ""; -delete $pubcmds{'moon'} if (! $::moon); - -$::uuid = "./uuidgen/uuidgen"; -$::uuid = (-f $::uuid) ? $::uuid : ""; -delete $pubcmds{'uuid'} if (! $::uuid); - -my $phase; -my $last_moon = 0; -my $last_uuid = 0; - -# leave @trees empty if you don't want tinderbox details -# @all_trees must be a superset of @trees - -my @all_trees = qw (SeaMonkey SeaMonkey-Ports); -my @trees = qw (SeaMonkey); -if ($nick =~ /grend/) { - @trees = qw (Grendel); -} -my $trees; -my $status; -my $last_tree; -my %broken; -my @urls; -my $ftpsite="ftp.mozilla.org"; - -my $greet = 0; -my @greetings = - ( - "g'day", "bonjour", "guten tag", "konnichiwa", - "hello", "hola", "hi", "buono giorno", "aloha", - "hey", "'sup", "lo", "howdy", "saluton", "hei", - "hallo", "word", "yo yo yo", "rheeet", "bom dia", - "ciao" - ); - - -my $irc = new Net::IRC or confess "$0: duh?"; - -my $bot = $irc->newconn - ( - Server => $server, - Port => $port, - Nick => $nick, - Ircname => "mozilla.org bot/thing $VERSION", - Username => $nick, - ) -or die "$0: can't connect to $server, port $port"; - -&debug ("adding global handlers"); -$bot->add_global_handler ([ 251,252,253,254,302,255 ], \&on_startup); -$bot->add_global_handler (376, \&on_connect); -$bot->add_global_handler (433, \&on_nick_taken); -$bot->add_global_handler ([ 'disconnect', 'kill', 474, 465 ], \&on_boot); - -&debug ("adding more handlers"); -$bot->add_handler ('msg', \&on_msg); -$bot->add_handler ('public', \&on_public); -$bot->add_handler ('join', \&on_join); - -&debug ("scheduling stuff"); -$bot->schedule (0, \&tinderbox); -$bot->schedule (0, \&checksourcechange); -$bot->schedule (0, \&stocks); -$bot->schedule (0, \&ftp_scan); - -foreach my $i (keys %rdfcmds) { - $bot->schedule(0, \&rdfchannel, $rdfcmds{$i}); - $pubcmds{$i} = $rdfcmds{$i}; +if ($LOGGING) { + # set up the log directory + unless (defined($LOGFILEDIR)) { + if ($CHROOT) { + $LOGFILEDIR = '/log'; + } else { + # setpwent doesn't work on Windows, we should wrap this in some OS test + setpwent; # reset the search settings for the getpwuid call below + $LOGFILEDIR = (getpwuid($<))[7].'/log'; + } + } + "$LOGFILEDIR/$0" =~ /^(.*)$/os; # untaints the evil $0. + $LOGFILEPREFIX = $1; # for some reason, $0 is considered tainted here, but not in other cases... + mkdir($LOGFILEDIR); # if this fails for a bad reason, we'll find out during the next line } -&debug ("connecting to $server $port as $nick on $channel"); - -$::megahal = "./megahal/megahal"; -$::megahal = (-f $::megahal) ? $::megahal : ""; -#david: why does the following line need to be commented out? -#$::megahal_pid; - -if ($::megahal) { - $::WTR = FileHandle->new; - $::RDR = FileHandle->new; - $::megahal_pid = &init_megahal; - &debug ("Initializing MEGAHAL conversation AI\n"); +# begin session log... +&debug('-'x80); +&debug("$NAME $VERSION starting up"); +&debug('compilation took '.&days($^T).'.'); +if ($CHROOT) { + &debug('mozbot chroot()ed successfully'); } -# and done. - - -# Use this routine, always, instead of the standard "privmsg" routine. This -# one makes sure we don't send more than one message every two seconds or so, -# which will make servers not whine about us flooding the channel. +# secure the environment # -# Actually, it seems that we can send two in a row just fine, but at that -# point we should start throttling. +# XXX could automatically remove the current directory here but I am +# more comfortable with people knowing it is not allowed -- see the +# README file. +if ($ENV{'PATH'} =~ /^(?:.*:)?\.?(?::.*)?$/os) { + die 'SECURITY RISK. You cannot have \'.\' in the path. See the README. Aborted'; +} +$ENV{'PATH'} =~ /^(.*)$/os; +$ENV{'PATH'} = $1; # we have to assume their path is otherwise safe, they called us! +delete (@ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'}); -my $lastsenttime = 0; -my @msgqueue = (); -sub sendmsg { - my ($who, $msg) = (@_); - my $now = time(); - if ($now > $lastsenttime && 0 == @msgqueue) { - $bot->privmsg($who, $msg); - $lastsenttime = $now; - } else { - push(@msgqueue, [$who, $msg]); - if (1 == @msgqueue) { - $bot->schedule(0, \&drainmsgqueue); - } - } + +# read the configuration file +my $cfgfile = shift || "$0.cfg"; +$cfgfile =~ /^(.*)$/os; +$cfgfile = $1; # untaint it -- we trust this, it comes from the admin. +&debug("reading configuration from '$cfgfile'..."); + +# - setup variables +# note: owner is only used by the Mails module +my ($server, $port, @nicks, @channels, $owner, @modulenames, @ignoredUsers); +my $nick = 0; +my $sleepdelay = 60; +my $connectTimeout = 120; +my $delaytime = 1.3; +my $variablepattern = '[-_:a-zA-Z0-9]+'; +my %users = ('admin' => &newPassword('password')); # default password for admin +my %userFlags = ('admin' => 3); # bitmask; 0x1 = admin, 0x2 = delete user a soon as other admin authenticates +my $helpline = 'see http://www.mozilla.org/projects/mozbot/'; # used in IRC name and in help + +# - which variables can be saved. +®isterConfigVariables( + [\$server, 'server'], + [\$port, 'port'], + [\@nicks, 'nicks'], + [\$nick, 'currentnick'], # pointer into @nicks + [\@channels, 'channels'], + [\@ignoredUsers, 'ignoredUsers'], + [\@modulenames, 'modules'], + [\$owner, 'owner'], + [\$sleepdelay, 'sleep'], + [\$connectTimeout, 'connectTimeout'], + [\$delaytime, 'throttleTime'], + [\%users, 'users'], # usernames => &newPassword(passwords) + [\%userFlags, 'userFlags'], # usernames => bits + [\$variablepattern, 'variablepattern'], + [\$helpline, 'helpline'], + [\$Mails::smtphost, 'smtphost'], +); + +# - read file +&Configuration::Get($cfgfile, &configStructure()); # empty gets entire structure + +# - check variables are ok +# note. Ensure only works on an interactive terminal (-t). +# It will abort otherwise. +{ my $changed; # scope this variable +$changed = &Configuration::Ensure([ + ['Connect to which server?', \$server], + ['To which port should I connect?', \$port], + ['What channels should I join?', \@channels], + ['What is the e-mail address of my owner?', \$owner], + ['What is your SMTP host?', \$Mails::smtphost], +]); + +# - check we have some nicks +until (@nicks) { + $changed = &Configuration::Ensure([['What nicks should I use? (I need at least one.)', \@nicks]]) || $changed; + # the original 'mozbot 2.0' development codename (and thus nick) was oopsbot. } -sub drainmsgqueue { - if (0 < @msgqueue) { - my ($who, $msg) = (@{shift(@msgqueue)}); - $bot->privmsg($who, $msg); - $lastsenttime = time(); - if (0 < @msgqueue) { - $bot->schedule(2, \&drainmsgqueue); - } - } +# - check current nick pointer is valid +# (we assume that no sillyness has happened with $[ as, +# according to man perlvar, "Its use is highly discouraged".) +$nick = 0 if (($nick > $#nicks) or ($nick < 0)); + +# - check channel names are all lowercase + +foreach (@channels) { $_ = lc; } + +# save configuration straight away, to make sure it is possible and to save +# any initial settings on the first run, if anything changed. +if ($changed) { + &debug("saving configuration to '$cfgfile'..."); + &Configuration::Save($cfgfile, &configStructure()); } - +} # close the scope for the $changed variable +# ensure Mails is ready +&debug("setting up Mails module..."); +$Mails::debug = \&debug; +$Mails::owner = \$owner; + +# setup the IRC variables +&debug("setting up IRC variables..."); +my $uptime; +my $irc = new Net::IRC or confess("Could not create a new Net::IRC object. Aborting"); + +# connect +&debug("attempting initial connection..."); +&connect(); # hmm. + +# setup the modules array +my @modules; # we initialize it lower down (at the bottom in fact) +my $lastadmin; # nick of last admin to be seen +my %authenticatedUsers; # hash of user@hostname=>users who have authenticated ################################ # Net::IRC handler subroutines # ################################ -sub on_startup - { - my ($self, $event) = @_; - my (@args) = ($event->args); - shift (@args); +# setup connection +sub connect { + $uptime = time(); - &debug ("@args\n"); - } + &debug("connecting to $server:$port..."); -sub on_connect - { - my $self = shift; - &debug ("startup took " . (time - $^T) . " seconds"); + my ($bot, $mailed); - $self->join ($channel); + until ($bot = $irc->newconn( + Server => $server, + Port => $port, + Nick => $nicks[$nick], + Ircname => "$NAME $VERSION; $helpline", + Username => $USERNAME, + )) { + &debug("could not connect - are you sure '$server:$port' is a valid host?"); + $mailed = &Mails::ServerDown($server, $port, $nicks[$nick], "$NAME $VERSION; $helpline", $nicks[0]) unless $mailed; + sleep($sleepdelay); + &Configuration::Get($cfgfile, &configStructure(\$server, \$port, \@nicks, \$nick, \$owner, \$sleepdelay)); + &debug("connecting to $server:$port..."); + } + + &debug("connected! woohoo!"); + + # add the handlers + &debug("adding IRC handlers"); + + # $bot->debug(1); # this can help when debugging API stuff + + &debug(" + informational "); + $bot->add_global_handler([ # Informational messages -- print these to the console + 251, # RPL_LUSERCLIENT + 252, # RPL_LUSEROP + 253, # RPL_LUSERUNKNOWN + 254, # RPL_LUSERCHANNELS + 255, # RPL_LUSERME + 302, # RPL_USERHOST + 375, # RPL_MOTDSTART + 372, # RPL_MOTD + ], \&on_startup); + + $bot->add_global_handler([ # Informational messages -- print these to the console + 'snotice', # server notices + 409, # noorigin + 405, # toomanychannels XXX should do something about this! + 404, # cannot sent to channel + 403, # no such channel + 401, # no such server + 402, # no such nick + 407, # too many targets + ], \&on_notice); - $uptime = time; - } + &debug(" + end of startup "); + $bot->add_global_handler([ # should only be one command here - when to join channels + 376, # RPL_ENDOFMOTD + 422, # nomotd + ], \&on_connect); + + &debug(" + nick management "); + $bot->add_global_handler([ # when to change nick name + 433, # ERR_NICKNAMEINUSE + 436, # nick collision + ], \&on_nick_taken); + + &debug(" + connection management "); + $bot->add_global_handler([ # when to give up and go home + 'disconnect', 'kill', # bad connection, booted offline + 465, # ERR_YOUREBANNEDCREEP + ], \&on_disconnected); + $bot->add_handler('destroy', \&on_destroy); # when object is GCed. -# on_nick_taken: or do something smarter + &debug(" + channel handlers"); + $bot->add_handler('msg', \&on_private); # /msg bot hello + $bot->add_handler('public', \&on_public); # hello + $bot->add_handler('join', \&on_join); # when someone else joins + $bot->add_handler('part', \&on_part); # when someone else leaves + $bot->add_handler('topic', \&on_topic); # when topic changes in a channel + $bot->add_handler('notopic', \&on_topic); # when topic in a channel is cleared + $bot->add_handler('invite', \&on_invite); # when someone invites us + $bot->add_handler('quit', \&on_quit); # when someone quits IRC + $bot->add_handler('nick', \&on_nick); # when someone changes nick + $bot->add_handler('kick', \&on_kick); # when someone (or us) is kicked + $bot->add_handler('mode', \&on_mode); # when modes change + $bot->add_handler('umode', \&on_umode); # when modes of user change (by IRCop or ourselves) + # XXX could add handler for 474, # ERR_BANNEDFROMCHAN -sub on_nick_taken - { - die "hey! somebody took my nick!"; - } + &debug(" + whois messages"); + $bot->add_handler([ # ones we handle to get our hostmask + 311, # whoisuser + ], \&on_whois); + $bot->add_handler([ # ones we handle just by outputting to the console + 312, # whoisserver + 313, # whoisoperator + 314, # whowasuser + 315, # endofwho + 316, # whoischanop + 317, # whoisidle + 318, # endofwhois + 319, # whoischannels + ], \&on_notice); + &debug(" + CTCP handlers"); + $bot->add_handler('cping', \&on_cping); # client to client ping + $bot->add_handler('crping', \&on_cpong); # client to client ping (response) + $bot->add_handler('cversion', \&on_version); # version info of mozbot.pl + $bot->add_handler('csource', \&on_source); # where is mozbot.pl's source + $bot->add_handler('caction', \&on_me); # when someone says /me + $bot->add_handler('cgender', \&on_gender); # guess + + &debug("handlers added"); + + $bot->schedule($connectTimeout, \&on_check_connect); + + # and done. + &Mails::ServerUp($server) if $mailed; -sub do_command { - my ($hashref, $nick, $cmd, $rest) = (@_); - foreach my $m (keys %$hashref) { - if ($cmd =~ m/^$m$/) { - my $ref = $hashref->{$m}; - if (ref($ref)) { - &{$ref} ($nick, $cmd, $rest); - } else { - bot_rdfchannel($nick, $cmd, $rest, $ref); - } - return 1; - } - } - return 0; } - - -# on_msg: private message received via /msg - -sub on_msg { +# called when the client receives a startup-related message +sub on_startup { my ($self, $event) = @_; - my ($nick) = $event->nick; - my ($arg) = $event->args; - my @arglist = split(' ', $arg); - my $cmd = shift @arglist; - my $rest = join(' ', @arglist); - $::speaker = $nick; # Hack!!! - - - if (exists $admins{$nick}) { - if (do_command(\%admincmds, $nick, $cmd, $rest)) { - return; - } - } - if (do_command(\%msgcmds, $nick, $cmd, $rest)) { - return; - } - if (do_command(\%pubcmds, $nick, $cmd, $rest)) { - return; - } - do_unknown($nick, $cmd, $rest); + my (@args) = $event->args; + shift(@args); + &debug(join(' ', @args)); } - - -sub bot_bless { - my ($nick, $cmd, $rest) = (@_); - my ($who, $where) = split(' ', $rest); - if (! $who or ! $where) { - sendmsg($nick, "usage: bless [ user ] [ host ] " . - "(example: bless marca netscape.com)"); - return; - } - $admins{$who} = $where; - &debug ("$nick blessed $who ($where)"); - &store_admin_conf (\%admins); - sendmsg($nick, "mozbot admins: " . join ' ', (sort keys %admins)); +# called when the client receives a server notice +sub on_notice { + my ($self, $event) = @_; + &debug($event->type.': '.join(' ', $event->args)); } -sub ftp_clear { - %latestbuilds=(); +# called when the client receives whois data +sub on_whois { + my ($self, $event) = @_; + &debug('collecting whois information: '.join('|', $event->args)); + # XXX could cache this information and then autoop people from + # the bot's host, or whatever } -sub ftp_stamp { - my $nick=$_[0]; - my $msg = "Available from $ftpsite: " . - join(' ', sort(keys(%latestbuilds))); - saylongline($nick, $msg, " ... "); -} +my ($nickHadProblem, $nickProblemEscalated, $nickOriginal) = (0, 0, 0); -sub ftp_check { - my $nick=($_[0])?$_[0]:$channel; - my $buf=""; - my $mdtms; - my $ftpserver=($_[2])?$_[2]:$ftpsite; - my $ftp = new Net::FTP($ftpserver, Debug => 0); - &debug ("fetching FTP $ftpserver nightly/latest"); - if ($ftp->login("anonymous","mozbot\@localhost")){ - $ftp->cwd("/pub/mozilla/nightly/latest"); - for my $f ($ftp->ls){ - $mdtms=$ftp->mdtm($f); - if (!$latestbuilds{$f} || $mdtms>$latestbuilds{$f}) { - $buf.=$f."; "; - $latestbuilds{$f}=$mdtms; - } - } - $ftp->quit; - }; - $buf="New files @ ftp://$ftpserver/pub/mozilla/nightly/latest ".$buf if ($buf); - &debug("$nick $buf"); - if ($ftpscanned) { - sendmsg($nick, $buf); - } - $ftpscanned = 1; -} -#DBM or DB_File %hash that's tied to a file -#DBM and DB_File are documented on the -# http://www.perl.com/CPAN-local/doc/manual/html/lib/ page. -# (note there are several DBM links there so be sure to check each -# (= exhaustive look not brief look)) -# timeless believes ftp info doesn't need to persist across multiple sessions -# of mozbot -# Lots of help from - -sub ftp_scan{ - ftp_check(0); - $bot->schedule(300,\&ftp_scan); -} - -sub bot_unbless { - my ($nick, $cmd, $rest) = (@_); - my ($who) = ($rest); - if (exists ($admins{$who})) { - delete $admins{$who}; - &debug ("$nick unblessed $who"); - &store_admin_conf (\%admins); - sendmsg($nick, "mozbot admins: " . join ' ', (sort keys %admins)); - return; - } - sendmsg($nick, "Can only unbless one of: " . - join(' ', (sort keys %admins))); -} - -sub bot_shutdown { - my ($nick, $cmd, $rest) = (@_); - if ($rest ne "yes") { - sendmsg($nick, "usage: shutdown yes"); - return; - } - &debug ("forced shutdown from $nick"); - $::dontQuitOnSignal++; - $bot->quit ("$nick told me to shutdown"); - exit (0); -} - - -sub bot_say { - my ($nick, $cmd, $rest) = (@_); - my $text = $rest; - if ($text =~ m@^/me (.*)@) { - $bot->me($channel, $1); +sub on_nick_taken { + my ($self, $event, $nickSlept) = @_, 0; + return unless $self->connected(); + if ($nickSlept) { + &debug("waited for a bit -- reading $cfgfile then searching for a nick..."); + &Configuration::Get($cfgfile, &configStructure(\@nicks, \$nick)); + $nick = 0 if ($nick > $#nicks) or ($nick < 0); # sanitise + $nickOriginal = $nick; } else { - sendmsg($channel, $text); + if (!$nickHadProblem) { + &debug("preferred nick ($nicks[$nick]) in use, searching for another..."); + $nickOriginal = $nick; + $nickHadProblem++; + } # else we are currently looping + $nick++; + $nick = 0 if $nick > $#nicks; + if ($nick == $nickOriginal) { + # looped! + local $" = ", "; + &debug("could not find an unused nick"); + &debug("nicks tried: @nicks"); + if (-t) { + print "Please suggest a nick (blank to abort): "; + my $new = <>; + chomp($new); + if ($new) { + @nicks = (@nicks[0..$nickOriginal], $new, @nicks[$nickOriginal+1..$#nicks]); + &debug("saving nicks: @nicks"); + &Configuration::Save($cfgfile, &configStructure(\@nicks)); + } else { + &debug("Could not find an unused nick"); + exit(1); + } + } else { + &debug("edit $cfgfile to add more nicks *hint* *hint*"); + $nickProblemEscalated = Mails::NickShortage($cfgfile, $self->server, $self->port, + $self->username, $self->ircname, @nicks) unless $nickProblemEscalated; + $nickProblemEscalated++; + &debug("going to wait $sleepdelay seconds so as not to overload ourselves."); + $self->schedule($sleepdelay, \&on_nick_taken, $event, 1); # try again, this time don't mail if it goes wrong + return; # otherwise we no longer respond to pings. + } + } } + &debug("now going to try nick $nicks[$nick]"); + $self->nick($nicks[$nick]); } +# called when we connect. +sub on_connect { + my $self = shift; -sub bot_list { - my ($nick, $cmd, $rest) = (@_); - my @list; - foreach (sort keys %admins) { - push(@list, "$_ $admins{$_}"); + if (defined($self->{'__mozbot__shutdown'})) { # HACK HACK HACK + &debug('Uh oh. I connected anyway, even though I thought I had timed out.'); + &debug('I\'m going to increase the timeout time by 20%.'); + $connectTimeout = $connectTimeout * 1.2; + &Configuration::Save($cfgfile, &configStructure(\$connectTimeout)); + $self->quit('having trouble connecting, brb...'); + return; } - my $spacer = " ... "; - saylongline($nick, join($spacer, @list), $spacer); + + &debug("using nick '$nicks[$nick]'"); + if ($nickHadProblem) { + # Remember which nick we are using + &Configuration::Save($cfgfile, &configStructure(\$nick)); + Mails::NickOk($nicks[$nick]) if $nickProblemEscalated; + } + + # -- #mozwebtools was here -- + # *** oopsbot (oopsbot@129.59.231.42) has joined channel #mozwebtools + # *** Mode change [+o oopsbot] on channel #mozwebtools by timeless + # <timeless> wow an oopsbot! + # *** Signoff: oopsbot (oopsbot@129.59.231.42) has left IRC [Leaving] + # <timeless> um + # <timeless> not very stable. + + # now load all modules + @modules = ( # the 'internal' modules + BotModules::Admin->create('Admin', ''), # admin commands + BotModules::General->create('General', ''), # help-related commands + ); + foreach (@modulenames) { + my $result = LoadModule($_); + if (ref($result)) { + &debug("loaded $_"); + } else { + &debug("failed to load $_", $result); + } + } + + # mass-configure the modules + &debug("loading module configurations..."); + { my %struct; # scope this variable + foreach my $module (@modules) { %struct = (%struct, %{$module->configStructure()}); } + &Configuration::Get($cfgfile, \%struct); + } # close the scope for the %struct variable + + # tell the modules they have joined IRC + foreach my $module (@modules) { $module->JoinedIRC({'bot'=>$self}); } + + # join the channels + &debug('going to join: '.join(',', @channels)); + $self->join(join(',', @channels)); + + # try to get our hostname + $self->whois($self->nick); + + # tell the modules to set up the scheduled commands + &debug('setting up scheduler...'); + foreach my $module (@modules) { $module->Schedule({'bot'=>$self}); } + + # enable the drainmsgqueue + &drainmsgqueue($self); + + # signal that we are connected (see next two functions) + $self->{'__mozbot__active'} = 1; # HACK HACK HACK + + # all done! + &debug('initialisation took '.&days($uptime).'.'); + $uptime = time(); + } +sub on_check_connect { + my $self = shift; + return if (defined($self->{'__mozbot__shutdown'}) or defined($self->{'__mozbot__active'})); # HACK HACK HACK + $self->{'__mozbot__shutdown'} = 1; # HACK HACK HACK + &debug("connection timed out -- trying again"); + foreach (@modules) { $_->unload(); } + @modules = (); + $self->quit('connection timed out -- trying to reconnect'); + &connect(); +} +# if something nasty happens +sub on_disconnected { + my $self = shift; + return if defined($self->{'__mozbot__shutdown'}); # HACK HACK HACK + $self->{'__mozbot__shutdown'} = 1; # HACK HACK HACK + &debug("eek! disconnected from network"); + foreach (@modules) { $_->unload(); } + @modules = (); + &connect(); +} +# if something nasty happens +sub on_destroy { + &debug("Connection: garbage collected"); +} +# on_public: messages received on channels sub on_public { my ($self, $event) = @_; - my ($to) = $event->to; - my ($arg) = $event->args; - my ($nick, $me) = ($event->nick, $self->nick); - $::speaker = $nick; # Hack!!! - -# catch urls, stick them in a list for mozbot's url command - - if ($arg =~ /(http|ftp|gopher):/i && $nick ne $me) { - push @urls, "$arg (" . &logdate() . ")"; - while ($#urls > 10) { - shift @urls; - } - } - if (my ($cmd, $rest) = $arg =~ /^$me[:,]?\s+(\S+)(?:\s+(.*))?$/i) { - if (do_command(\%pubcmds, $channel, $cmd, $rest)) { - return; + if ($event->nick ne $self->nick) { + my $data = join(' ', $event->args); + my $nick = quotemeta($self->nick); + if ($data =~ /^(\s*$nick(?:[-\s,:;.!?]+|\s*-+>?\s+))(.+)$/is) { + if ($2) { + $event->args($2); + &do($self, $event, 'Told', 'Baffled'); + } else { + &do($self, $event, 'Heard'); + } } else { - do_unknown($channel, $cmd, $rest); + &do($self, $event, 'Heard'); + } + } +} + +sub on_private { + my ($self, $event) = @_; + my $data = join(' ', $event->args); + my $nick = quotemeta($self->nick); + if (($data =~ /^($nick(?:[-\s,:;.!?]|\s*-+>?\s+))(.+)$/is) and ($2)) { + # we do this so that you can say 'mozbot do this' in both channels + # and /query screens alike (otherwise, in /query screens you would + # have to remember to omit the bot name). + $event->args($2); + } + &do($self, $event, 'Told', 'Baffled'); +} + +# on_me: /me actions (CTCP actually) +sub on_me { + my ($self, $event) = @_; + if ($event->nick ne $self->nick) { + my @data = $event->args; + my $data = join(' ', @data); + $event->args($data); + my $nick = quotemeta($self->nick); + if ($data =~ /(?:^|[\s":<([])$nick(?:[])>.,?!\s'&":]|$)/is) { + &do($self, $event, 'Felt'); + } else { + &do($self, $event, 'Saw'); + } + } +} + +# on_topic: for when someone changes the topic +# also for when the server notifies us of the topic +# ...so we have to parse it carefully. +sub on_topic { + my ($self, $event) = @_; + if ($event->userhost eq '@') { + # server notification + # need to parse data + my (undef, $channel, $topic) = $event->args; + $event->args($topic); + $event->to($channel); + } + &do(@_, 'SpottedTopicChange'); +} + +# on_kick: parse the kick event +sub on_kick { + my ($self, $event) = @_; + my ($channel, $from) = $event->args; # from is already set anyway + my $who = $event->to; + $event->to($channel); + foreach (@$who) { + $event->args($_); + if ($_ eq $self->nick) { + &do(@_, 'Kicked'); + } else { + &do(@_, 'SpottedKick'); + } + } +} + +# Yells about incoming CTCP PINGs. +sub on_cping { + my ($self, $event) = @_; + $self->ctcp_reply($event->nick, join(' ', ($event->args))); + &debug('received CTCP PING request from '.$event->nick.' and responded'); +} + +# Gives lag results for outgoing PINGs. +sub on_cpong { + my ($self, $event) = @_; + &debug('completed CTCP PING with '.$event->nick.': '.days($event->args->[0])); + # XXX should be able to use this then... see also Greeting module + # in standard distribution +} + +# -- #mozbot was here -- +# <timeless> $conn->add_handler('gender',\&on_ctcp_gender); +# <timeless> sub on_ctcp_gender{ +# <timeless> my (undef, $event)=@_; +# <timeless> my $nick=$event->nick; +# <Hixie> # timeless this suspense is killing me! +# <timeless> $bot->ctcp_reply($nick, 'neuter'); +# <timeless> } + +# on_gender: What gender are we? +sub on_gender { + my ($self, $event) = @_; + my $nick = $event->nick; + $self->ctcp_reply($nick, 'neuter'); +} # well, close enough... + +# simple handler for when users do various things and stuff +sub on_join { &do(@_, 'SpottedJoin'); } +sub on_part { &do(@_, 'SpottedPart'); } +sub on_quit { &do(@_, 'SpottedQuit'); } +sub on_invite { &do(@_, 'Invited'); } +sub on_nick { &do(@_, 'SpottedNickChange'); } +sub on_mode { &do(@_, 'ModeChange'); } # XXX need to parse modes +sub on_umode { &do(@_, 'UModeChange'); } +sub on_version { &do(@_, 'Version'); } +sub on_source { &do(@_, 'Source'); } + +sub do { + my $self = shift @_; + my $event = shift @_; + my $channel = ''; # if message was sent to one channel only, this is it. + my $to = $event->to; + foreach (@$to) { + if (/^[#&+\$]/os) { + if ($channel) { + $channel = ''; + last; + } else { + $channel = $_; + } + } elsif ($_ eq $self->nick) { + $channel = ''; + last; + } + } + $channel = lc($channel); + my $e = { + 'bot' => $self, + '_event' => $event, # internal internal internal do not use... ;-) + 'channel' => $channel, + 'from' => $event->nick, + 'target' => $channel || $event->nick, + 'user' => $event->userhost, + 'data' => join(' ', $event->args), + 'to' => $to, + 'subtype' => $event->type, + 'firsttype' => $_[0], + 'nick' => $self->nick(), + # level (set below) + # type (set below) + }; + # updated admin field if person is an admin + if ($authenticatedUsers{$event->userhost}) { + if (($userFlags{$authenticatedUsers{$event->userhost}} & 1) == 1) { + $lastadmin = $event->nick; + } + $e->{'userName'} = $authenticatedUsers{$event->userhost}; + $e->{'userFlags'} = $userFlags{$authenticatedUsers{$event->userhost}}; + } else { + $e->{'userName'} = 0; + } + unless (scalar(grep($e->{'user'} =~ /^\Q$_\E$/g, @ignoredUsers))) { + my $continue; + do { + my $type = shift @_; + my $level = 0; + my @modulesInNextLoop = @modules; + $continue = 1; + $e->{'type'} = $type; + &debug("$type: $channel <".$event->nick.'> '.join(' ', $event->args)); + do { + $level++; + $e->{'level'} = $level; + my @modulesInThisLoop = @modulesInNextLoop; + @modulesInNextLoop = (); + foreach my $module (@modulesInThisLoop) { + my $currentResponse; + eval { + $currentResponse = $module->do($self, $event, $type, $e); + }; + if ($@) { + # $@ contains the error + &debug("ERROR IN MODULE $module->{'_name'}!!!", $@); + } elsif (!defined($currentResponse)) { + &debug("ERROR IN MODULE $module->{'_name'}: invalid response code to event '$type'."); + } else { + if ($currentResponse > $level) { + push(@modulesInNextLoop, $module); + } + $continue = ($continue and $currentResponse); + } + } + } while (@modulesInNextLoop); + } while ($continue and scalar(@_)); + } else { + &debug("Ignored: $channel <".$event->nick.'> '.join(' ', $event->args)); + } + foreach my $module (@modules) { + eval { + $module->Log($e); + }; + if ($@) { + # $@ contains the error + &debug("ERROR!!!", $@); } } } -sub do_unknown { - my ($nick, $cmd, $rest) = (@_); - if (defined $::megahal_pid) { - my $sentence = $cmd . " " . $rest . "\n"; - &debug($sentence); - print $::WTR $sentence . "\n"; - my $result = ($::RDR)->getline; - &debug($result . "\n"); - sendmsg($nick, $result); - } - else { - if (!defined $::eliza) { - $::eliza = new Chatbot::Eliza; +################################ +# internal utilities # +################################ + +my @msgqueue; +my $timeLastSetAway = 0; # the time since the away flag was last set, so that we don't set it repeatedly. + +# Use this routine, always, instead of the standard "privmsg" routine. This +# one makes sure we don't send more than one message every two seconds or so, +# which will make servers not whine about us flooding the channel. +# messages aren't the only type of flood :-( away is included +sub sendmsg { + my ($self, $who, $msg, $do) = (@_, 'msg'); + unless ((defined($do)) and (defined($msg)) and (defined($who)) and (not ref($msg)) and ($who ne '')) { + cluck('Wrong arguments passed to sendmsg() - ignored'); + } else { + $self->schedule($delaytime / 2, \&drainmsgqueue) unless @msgqueue; + foreach (splitMessageAcrossLines($msg)) { + push(@msgqueue, [$who, $_, $do]); } - my $result = $::eliza->transform("$cmd $rest"); - sendmsg($nick, $result); } } +# send any pending messages +sub drainmsgqueue { + my $self = shift; + return unless $self->connected; + my $qln = @msgqueue; + if (@msgqueue > 0) { + my ($who, $msg, $do) = getnextmsg(); + if ($do eq 'msg') { + &debug("->$who: $msg"); # XXX this makes logfiles large quickly... + $self->privmsg($who, $msg); # it seems 'who' can be an arrayref and it works + } elsif ($do eq 'me') { + &debug("->$who * $msg"); # XXX + $self->me($who, $msg); + } else { + &debug("Unknown action '$do' intended for '$who' (content: '$msg') ignored."); + } + if (@msgqueue > 0) { + if ((@msgqueue % 10 == 0) and (time() - $timeLastSetAway > 5 * $delaytime)) { + &bot_longprocess($self, "Long send queue. There were $qln, and I just sent one to $who."); + $timeLastSetAway = time(); + $self->schedule($delaytime * 4, # because previous one counts as message, plus you want to delay an extra bit regularly + \&drainmsgqueue); + } else { + $self->schedule($delaytime, \&drainmsgqueue); + } + } else { + &bot_back($self); # clear away state + } + } +} -sub saylongline { - my ($nick, $str, $spacer) = (@_); +# wrap long lines at spaces and hard returns (\n) +# this is for IRC, not for the console -- long can be up to 255 +sub splitMessageAcrossLines { + my ($str) = @_; my $MAXPROTOCOLLENGTH = 255; - - while (length ($str) > $MAXPROTOCOLLENGTH) { - my $pos; - $pos = rindex($str, $spacer, $MAXPROTOCOLLENGTH - length($spacer)); - if ($pos < 0) { - $pos = rindex($str, " ", $MAXPROTOCOLLENGTH - 1); + my @output; + # $str could be several lines split with \n, so split it first: + foreach my $line (split(/\n/, $str)) { + while (length($line) > $MAXPROTOCOLLENGTH) { + # position is zero-based index + my $pos = rindex($line, " ", $MAXPROTOCOLLENGTH - 1); if ($pos < 0) { $pos = $MAXPROTOCOLLENGTH - 1; } + push(@output, substr($line, 0, $pos)); + $line = substr($line, $pos); + $line =~ s/^\s+//gos; } - sendmsg($nick, substr($str, 0, $pos)); - $str = substr($str, $pos); - if (index($str, $spacer) == 0) { - $str = substr($str, length($spacer)); - } - } - if ($str ne "") { - sendmsg($nick, $str); + push(@output, $line) if $line; } + return @output; } - - - -sub do_headlines { - my ($nick, $header, $ref) = (@_); - my $spacer = " ... "; - my $str = $header . ": " . join($spacer, @$ref); - saylongline($nick, $str, $spacer); +# equivalent of shift or pop, but for the middle of the array. +# used by getnextmsg() below to pull the messages out of the +# msgqueue stack and shove them at the end. +sub yank { + my ($index, $list) = @_; + my $result = @{$list}[$index]; + @{$list} = (@{$list}[0..$index-1], @{$list}[$index+1..$#{$list}]); + return $result; } -sub reportDiffs { - my ($name, $url, $ref) = (@_); - - my $firsttime = 0; - if (!exists $::headCache{$url}) { - $firsttime = 1; - $::headCache{$url} = {}; - } - my $spacer = " ... "; - my $outstr = ""; - foreach my $i (@$ref) { - if ($i =~ /^last update/) { - next; - } - if (!exists $::headCache{$url}->{$i}) { - $::headCache{$url}->{$i} = 1; - if ($outstr eq "") { - $outstr = "Just appeared in $name - $url : "; - } else { - $outstr .= $spacer; - } - $outstr .= $i; - } - } - if (!$firsttime) { - saylongline($channel, $outstr, $spacer); - } -} - - - - - -sub bot_debug - { - my ($nick, $cmd, $rest) = (@_); - - my @list; - my %last = - ( - "tinderbox" => $last_tree, - "moon" => $last_moon, - "uuid" => $last_uuid, - ); - - foreach (keys %last) - { - if ($last{$_} != 0) - { - push @list, "$_ updated: " . &logdate ($last{$_}) . ", " . - &days ($last{$_}); - } - else - { - push @list, "$_ never updated!"; - } - } - - foreach (sort(keys %rdf_last)) { - push @list, "$_ updated: " . logdate($rdf_last{$_}) . ", " . - days($rdf_last{$_}); - } - - do_headlines ($nick, "Boring Debug Information", \@list); - } - -#timeless didn't like http://server): it upset his irc client/browser link -sub bot_rdfchannel { - my ($nick, $cmd, $rest, $url) = (@_); - if (defined $rdf_title{$url}) { - do_headlines($nick, "Items in $rdf_title{$url} - $rdf_link{$url} ", - $rdf_items{$url}); - } else { - sendmsg($nick, "Nothing has been found yet at $url"); - } -} - - - -sub bot_hi { - my ($nick, $cmd, $rest) = (@_); - sendmsg($nick, $greetings[$greet++] . " $::speaker"); - $greet = 0 if ($greet > $#greetings); -} - - - -sub on_join - { - my ($self, $event) = @_; - my ($channel) = ($event->to)[0]; - my $nick = $event->nick; - my $userhost = $event->userhost; - - # auto-op if user is a mozbot admin and coming in from - # the right host - - if (exists $admins{$nick} && $userhost =~ /$admins{$nick}$/i) - { - $self->mode ($channel, "+o", $nick); - &debug ("auto-op for $nick on $channel"); - } - } - -$::dontQuitOnSignal = 0; -sub on_boot - { - if (!$::dontQuitOnSignal) { - die "$0: disconnected from network"; - } - } - - -sub listcmds { - my ($hashref) = (@_); - my @list; - foreach my $k (keys %$hashref) { - if ($k =~ m/^\(([a-z]+)\|/) { - push @list, $1; +# looks at the msgqueue stack and decides which message to send next. +sub getnextmsg { + my ($who, $msg, $do) = @{shift(@msgqueue)}; + my @newmsgqueue; + my $index = 0; + while ($index < @msgqueue) { + if ($msgqueue[$index]->[0] eq $who) { + push(@newmsgqueue, &yank($index, \@msgqueue)); } else { - push @list, $k; + $index++; } } - return join(' ', sort(@list)); + push(@msgqueue, @newmsgqueue); + return ($who, $msg, $do); +} + +my $markedaway = 0; + +# mark bot as being away +sub bot_longprocess { + my $self = shift; + &debug('[away: '.join(' ',@_).']'); + $self->away(join(' ',@_)); + $markedaway = @_; +} + +# mark bot as not being away anymore +sub bot_back { + my $self = shift; + $self->away('') if $markedaway; + $markedaway = 0; } +# internal routines for IO::Select handling - - -################ -# bot commands # -################ - -# bot_about: it's either an about box or the -# address of the guy to blame when the bot -# breaks - -sub bot_about { - my ($nick, $cmd, $rest) = @_; - sendmsg($::speaker, "i am mozbot version $VERSION. hack on me! " . - "harrison\@netscape.com 10/16/98. " . - "connected to $server since " . - &logdate ($uptime) . " (" . &days ($uptime) . "). " . - "see http://bonsai.mozilla.org/cvsquery.cgi?branch=HEAD&file=mozilla/webtools/mozbot/&date=week " . - "for a changelog."); - sendmsg($::speaker, "Known commands are: " . - listcmds(\%pubcmds)); - sendmsg($::speaker, "If you /msg me, I'll also respond to: " . - listcmds(\%msgcmds)); - if (exists $admins{$::speaker}) { - sendmsg($::speaker, "And you're an admin, so you can also do: " . - listcmds(\%admincmds)); +sub bot_select { + my ($pipe) = @_; + $irc->removefh($pipe); + # enable slurp mode for this function (see man perlvar for $/ documentation) + local $/; + undef $/; + my $data = <$pipe>; + &debug("child ${$pipe}->{'BotModules_PID'} completed ${$pipe}->{'BotModules_ChildType'}". + (${$pipe}->{'BotModules_Module'}->{'_shutdown'} ? + ' (nevermind, module has shutdown)': '')); + waitpid(${$pipe}->{'BotModules_PID'}, 0); + return if ${$pipe}->{'BotModules_Module'}->{'_shutdown'}; # see unload() + eval { + ${$pipe}->{'BotModules_Module'}->ChildCompleted( + ${$pipe}->{'BotModules_Event'}, + ${$pipe}->{'BotModules_ChildType'}, + $data, + @{${$pipe}->{'BotModules_Data'}} + ); + }; + if ($@) { + # $@ contains the error + &debug("ERROR!!!", $@); } - if ($nick eq $channel) { - sendmsg($nick, - "[ Directions on talking to me have been sent to $::speaker ]"); - } - } -# bot_moon: goodnight moon -sub get_moon_str - { - return "- no moon -" if (! defined $::moon); - return $phase if ($phase && (time - $last_moon > (60 * 60 * 24))); - - # we only want to run this once/day - $phase = `$::moon`; - $last_moon = time; - return $phase; - } +# internal routines for console output, stuff -sub bot_moon { - my ($nick, $cmd, $rest) = @_; - sendmsg($nick, get_moon_str()); -} - -sub get_uuid_str { - my $this_uuid; - return "- no uuid -" if (! defined $::uuid); - $this_uuid = `$::uuid`; - return $this_uuid; - } - -sub bot_uuid { - my ($nick, $cmd, $rest) = @_; - sendmsg($nick, get_uuid_str()); - } - - -# bot_up: report uptime - -sub bot_up { - my ($nick, $cmd, $rest) = @_; - sendmsg($nick, &logdate ($uptime) . " (" . &days ($uptime) . ")"); -} - -# bot_urls: show last ten urls caught by mozbot - -sub bot_urls { - my ($nick, $cmd, $rest) = @_; - if ($#urls == -1) { - sendmsg($nick, "- mozbot has seen no URLs yet -"); - } else { - foreach my $m (@urls) { - sendmsg($nick, $m); +# print debugging info +sub debug { + my $line; + foreach (@_) { + $line = $_; # can't chomp $_ since it is a hardref to the arguments... + chomp $line; # ...and they are probably a constant string! + if (-t) { + print &logdate() . " ($$) $line"; } - } -} - -# show tinderbox status -# -# this is a messy little function but it works. - -sub bot_tinderbox { - my ($nick, $cmd, $rest) = @_; - my $bustage; - my $buf; - my @buf; - my @tree; -# my @rstats; -# my $ttree; - my $rg=0; - my $ry=0; - my $rr=0; - my $terse = (defined $rest && $rest eq "all"); - if ($nick eq $channel) { - $terse = 1; - } - - # user can supply a list of trees separated - # by whitespace, default is all trees - - push @tree, $rest ? (split /\s+/, $rest) : @trees; - - # loop through requested trees - - push @buf, "Tinderbox status from http://tinderbox.mozilla.org/showbuilds.cgi"; - - foreach my $t (@tree) - { - $bustage = 0; - $buf = "$t " . ($$status{$t} ? "<$$status{$t}> " : "") . ": "; - # politely report failures - if (! exists $$trees{$t}) - { - $buf .= "unknown tree \"$t\", trees include @all_trees. "; + if ($LOGGING) { + # XXX this file grows without bounds!!! + if (open(LOG, ">>$LOGFILEPREFIX.$$.log")) { + print LOG &logdate() . " $line\n"; + close(LOG); + print "\n"; + } else { + print " [not logged, $!]\n"; } - else - { - $rg=0; - $ry=0; - $rr=0; - foreach my $e (sort keys %{$$trees{$t}}) - { -$rg++ if ($$trees{$t}{$e}=~/Success/); -$ry++ if ($$trees{$t}{$e}=~/Test Failed/); -$rr++ if ($$trees{$t}{$e}=~/Horked/); -&debug("$rg $ry $rr $e => $$trees{$t}{$e}"); - next if ($terse && $$trees{$t}{$e} eq "Success"); - $buf .= "[$e: $$trees{$t}{$e}] "; - $bustage++; - } - } - -# $buf .= "- no known bustage -" if (! $bustage); - if ( $bustage) {$buf .= -"$rg success, $ry test failures, and $rr horked.";} - else { $buf .= "- no known bustage -";}; - push @buf, $buf; } - - $buf = $buf || - "something broke. report a bug here: " . - "http://bugzilla.mozilla.org/enter_bug.cgi " . - "with product of Webtools and component set to Mozbot"; - - push @buf, "last update: " . - &logdate ($last_tree) . " (" . &days ($last_tree) . " ago)"; - - - foreach my $m (@buf) { - sendmsg($nick, $m); } - } -############# -# utilities # -############# - -sub debug - { - return if (! $debug); - - foreach (@_) - { -#timeless: Broken -# chomp; - print &logdate() . " $_ [$$]\n"; - } - } - -# logdate: return nice looking date (10/16/98 18:29) - -sub logdate - { - my $t = shift; - $t = time unless ($t); - my ($sec,$min,$hour,$mday,$mon,$year) = localtime ($t); - - return sprintf ("%02d/%02d/%02d %02d:%02d", - $mon + 1, $mday, $year + 1900, $hour, $min); - } +# logdate: return nice looking date and time stamp +sub logdate { + my ($sec, $min, $hour, $mday, $mon, $year) = gmtime(shift or time); + return sprintf("%d-%02d-%02d %02d:%02d:%02d UTC", + $year + 1900, $mon + 1, $mday, $hour, $min, $sec); +} # days: how long ago was that? - -sub days - { - my ($then) = shift; - - my $seconds = time - $then; - my $minutes = int ($seconds / 60); - my $hours = int ($minutes / 60); - my $days = int ($hours / 24); - - if ($seconds < 60) - { return (sprintf "%d second%s", $seconds, $seconds == 1 ? "" : "s"); } - elsif ($minutes < 60) - { return (sprintf "%d minute%s", $minutes, $minutes == 1 ? "" : "s"); } - elsif ($hours < 24) - { return (sprintf "%d hour%s", $hours, $hours == 1 ? "" : "s"); } - else - { return (sprintf "%d day%s", $days, $days == 1 ? "" : "s"); } - } +sub days { + my $then = shift; + # maths + my $seconds = time - $then; + my $minutes = int ($seconds / 60); + my $hours = int ($minutes / 60); + my $days = int ($hours / 24); + # english + if ($seconds < 60) { + return sprintf("%d second%s", $seconds, $seconds == 1 ? "" : "s"); + } elsif ($minutes < 60) { + return sprintf("%d minute%s", $minutes, $minutes == 1 ? "" : "s"); + } elsif ($hours < 24) { + return sprintf("%d hour%s", $hours, $hours == 1 ? "" : "s"); + } else { + return sprintf("%d day%s", $days, $days == 1 ? "" : "s"); + } +} # signal handler - -sub killed - { - if ($::megahal_pid) { - &debug("Killing megahal.\n"); - kill (2, $::megahal_pid); - } - confess "i have received a signal of some manner. good night.\n\n"; - } - -# write admin list - -sub store_admin_conf - { - my $admins = shift; - my $when = localtime (time) . " by $$"; - - if (open ADMINS, ">$adminf") - { - print ADMINS <<FIN; -# mozbot admin list file -# -# this file is generated. do not edit. -# generated $when -# -# version: 1.0 - -FIN - - foreach (sort keys %admins) - { - print ADMINS "$_ $admins{$_}\n"; - } - close ADMINS; - } - else - { - &debug ("&store_admin_conf $adminf: $!"); - } - } - -# fetch list of admins - -sub fetch_admin_conf - { - my $admins = shift; - - if (open ADMINS, $adminf) - { - while (<ADMINS>) - { - chomp; - next if ($_ =~ /^#/ or ! $_); - my ($user, $host) = split /\s+/, $_; - $$admins{$user} = $host; - } - &debug ("admins: " . keys %$admins); - } - else - { - &debug ("&fetch_admin_conf $adminf: $!"); - } - - close ADMINS; - } - -# create a pid file if we can - -sub create_pid_file - { - my $pid = ".$nick-pid"; - - if (open PID, ">$pid") - { - print PID "$$\n"; - close PID; - } - else - { - &debug ("warning: problem creating pid file: $pid, $!"); - } - } - -sub init_megahal { - my $pid; - chdir("./megahal"); - $pid = open2($::RDR, $::WTR, "./megahal"); - chdir(".."); - return($pid); - +sub killed { + my($sig) = @_; + &debug("received signal $sig. shutting down..."); + &debug('This is evil. You should /msg me a shutdown command instead.'); + &debug('WARNING: SHUTTING ME DOWN LIKE THIS CAN CAUSE FORKED PROCESSES TO START UP AS BOTS!!!'); # XXX which we should fix, of course. + exit(1); # sane exit, including shutting down any modules } -sub rdfchannel { - my ($foo, $url) = (@_); - debug("fetching rdfchannel $url"); - $bot->schedule(60*60, \&rdfchannel, $url); - my $output = get $url; - $rdf_last{$url} = time(); - return if (!$output); +# internal routines for configuration - my $channelpart = ""; - if ($output =~ m@<channel>(.*)</channel>@si) { - $channelpart = $1; +my %configStructure; # hash of cfg file keys and associated variable refs + +# ok. In strict 'refs' mode, you cannot use strings as refs. Fair enough. +# However, hash keys are _always_ strings. Using a ref as a hash key turns +# it into a string. So we have to keep a virgin copy of the ref around. +# +# So the structure of the %configStructure hash is: +# "ref" => [ cfgName, ref ] +# Ok? + +sub registerConfigVariables { + my (@variables) = @_; + foreach (@variables) { + $configStructure{$$_[0]} = [$$_[1], $$_[0]]; } - $output =~ s@<image>.*</image>@@si; +} # are you confused yet? - $rdf_title{$url} = $url; - if ($channelpart =~ m@<title>(.+?)@si) { - $rdf_title{$url} = trim($1); +sub configStructure { + my (@variables) = @_; + my %struct; + @variables = keys %configStructure unless @variables; + foreach (@variables) { + confess("Function configStructure was passed something that is either not a ref or has not yet neem registered, so aborted") unless defined($configStructure{$_}); + $struct{$configStructure{$_}[0]} = $configStructure{$_}[1]; } - $rdf_link{$url} = $url; - if ($channelpart =~ m@(.+?)@si) { - $rdf_link{$url} = trim($1); - } - - my @list; - while ($output =~ m@(.*?)(.+?)(.*?)@sig) { - push(@list, $2); - } - $rdf_items{$url} = \@list; - - - reportDiffs($rdf_title{$url}, $rdf_link{$url}, \@list); + return \%struct; } - +# internal routines for handling the modules -# fetch tinderbox details +sub getModule { + my ($name) = @_; + foreach my $module (@modules) { # XXX this is not cached as a hash as performance is not a priority here + return $module if $name eq $module->{'_name'}; + } + return undef; +} -sub tinderbox - { - &debug ("fetching tinderbox status"); - my ($newtrees, $newstatus) = Tinderbox::status (\@all_trees); - - if (! $newtrees) - { - $bot->schedule (90, \&tinderbox); - &debug ("hmm, couldn't get tinderbox status"); - return; - } - - $last_tree = time; - - if (defined $status) - { - foreach my $s (keys %$newstatus) - { - if (defined $$newstatus{$s} && $$status{$s} ne $$newstatus{$s}) - { - sendmsg($channel, - "$s changed state from $$status{$s} to $$newstatus{$s}"); - } - } - } - - if (defined $trees) { - foreach my $t (@trees) { - foreach my $e (sort keys %{$$newtrees{$t}}) { - if (!defined $$trees{$t}{$e}) { - sendmsg($channel, "$t: A new column '$e' has appeared ($$newtrees{$t}{$e})"); +sub LoadModule { + my ($name) = @_; + # sanitize the name + $name =~ s/[^-a-zA-Z0-9]/-/gos; + # check the module is not already loaded + foreach (@modules) { + if ($_->{'_name'} eq $name) { + return "Failed [0]: Module already loaded. Don't forget to enable it in the various channels (vars $name channels '+#channelname')."; + } + } + # read the module in from a file + my $filename = "./BotModules/$name.bm"; # bm = bot module + my $result = open(my $file, "< $filename"); + if ($result) { + local $/; + undef $/; # enable "slurp" mode + my $code = <$file>; # whole file now here + if ($code) { +# if ($code =~ /package\s+\QBotModules::$name\E\s*;/gos) { XXX doesn't work reliably?? XXX + # eval the file + $code =~ /^(.*)$/os; + $code = $1; # completely defeat the tainting mechanism. + # $code = "# FILE: $filename\n".$code; # "# file 1 '$filename' \n" would be good without Carp.pm + { no warnings; # as per the warning, but doesn't work??? XXX + eval($code); } + if ($@) { + # $@ contains the error + return "Failed [4]: $@"; } else { - if ($$trees{$t}{$e} ne $$newtrees{$t}{$e}) { - sendmsg($channel, "$t: '$e' has changed state from $$trees{$t}{$e} to $$newtrees{$t}{$e}"); + # if ok, then create a module + my $newmodule; + eval(" + \$newmodule = BotModules::$name->create('$name', '$filename'); + "); + if ($@) { + # $@ contains the error + return "Failed [5]: $@"; + } else { + # if ok, then add it to the @modules list + push(@modules, $newmodule); + # Done!!! + return $newmodule; } } - } - } - } - $trees = $newtrees; - $status = $newstatus; - - $bot->schedule (360, \&tinderbox); - } - - -# See if someone has changed our source. - -sub checksourcechange { - my ($self) = @_; - my $lastourdate = $::ourdate; - my $lasttinderboxdate = $::tinderboxdate; - my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size, - $atime,$mtime,$ctime,$blksize,$blocks) - = stat("./mozbot.pl"); - $::ourdate = $mtime; - ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size, - $atime,$mtime,$ctime,$blksize,$blocks) - = stat("./Tinderbox.pm"); - $::tinderboxdate = $mtime; - - if (defined $lastourdate && - ($::ourdate > $lastourdate || - $::tinderboxdate > $lasttinderboxdate)) { - $::dontQuitOnSignal = 1; - $self->quit("someone seems to have changed my source code. Be right back"); - &debug ("restarting self"); - exec "$0 @::origargv"; - } - $bot->schedule (60, \&checksourcechange); -} - - -sub stocks { - $bot->schedule(15 * 60, \&stocks); - - my $url = "http://quote.yahoo.com/d/quotes.csv?f=sl1d1t1c1ohgv&e=.csv&s=" . - join("+", sort(keys %stocklist)); - &debug ("fetching stock quotes $url"); - my $output = get $url; - return if (!$output); - %stockvals = (); - foreach my $line (split(/\n/, $output)) { - my @list = split(/,/, $line); - my $name = shift(@list); - $name =~ s/"(.*)"/$1/; - &debug ("parsing stock quote $name ($list[0]) $line"); - $stockvals{$name} = \@list; - foreach my $ref (@{$stockhist{$name}}) { - my $oldval = $ref->[0]; - my $newval = $list[0]; - my $ratio = $newval / $oldval; - if ($ratio > 1.05 || $ratio < 0.95) { - foreach my $who ($stocklist{$name}) { - ReportStock($who, $name, "Large Stock Change"); - } - $stockhist{$name} = []; - last; - } - } - if (!exists $stockhist{$name}) { - $stockhist{$name} = []; - } - push (@{$stockhist{$name}}, \@list); - while (30 < @{$stockhist{$name}}) { - shift @{$stockhist{$name}}; - } - } -} - - -sub LoadStockList { - %stocklist = ("AOL" => [$channel], - "RHAT" => [$channel], - "^DJI" => [$channel], - "^IXIC" => [$channel]); - - if (open(LIST, $stockf)) { - %stocklist = (); - while () { - my @list = split(/\|/, $_); - my $name = shift(@list); - $stocklist{$name} = \@list; - } - } -} - - -sub FracStr { - my ($num, $needplus) = (@_); - my $sign; - if ($num < 0) { - $sign = "-"; - $num = - $num; - } else { - $sign = $needplus ? "+" : ""; - $num =~ s/^\+//; - } - my $orignum = $num; - - my $bdot = int($num); - my $adot = $num - $bdot; - - if ($adot == 0) { - return "$sign$bdot"; - } - - my $base = 64; - $num = int($adot * $base); - - while ($num % 2 == 0 && $base > 1) { - $base /= 2; - $num /= 2; - } - - if ($adot == $num / $base) { - if ($bdot == 0) { - $bdot = ""; +# } else { +# return "Failed [3]: Could not find valid module definition line."; +# } } else { - $bdot .= " "; + # $! contains the error + if ($!) { + return "Failed [2]: $!"; + } else { + return "Failed [2]: Module file is empty."; + } } - return "$sign$bdot$num/$base"; + } else { + # $! contains the error + return "Failed [1]: $!"; + } +} + +sub UnloadModule { + my ($name) = @_; + # remove the reference from @modules + my @newmodules; + foreach (@modules) { + if ($name eq $_->{'_name'}) { + if ($_->{'_static'}) { + return 'Cannot unload this module, it is built in.'; + } + $_->unload(); + } else { + push(@newmodules, $_); + } + } + if (@modules == @newmodules) { + return 'Module not loaded. Are you sure you have the right name?'; + } else { + @modules = @newmodules; + return; + } +} + +# password management functions + +sub getSalt { + # straight from man perlfunc + return join('', ('.', '/', 0..9, 'A'..'Z', 'a'..'z')[rand 64, rand 64]); +} + +sub newPassword { + my($text) = @_; + return crypt($text, &getSalt()); +} + +sub checkPassword { + my($text, $password) = @_; + return (crypt($text, $password) eq $password); +} + +################################ +# Base Module # +################################ + +# And now, for my next trick, the base module (duh). + +package BotModules; + +1; # nothing to see here... + +# ENGINE INTERFACE + +# create - create a new BotModules object. +# Do not call this yourself. We call it. Ok? +# Do not override this either, unless you know what +# you are doing (I don't, and I wrote it...). If you +# want to add variables to $self, use Initialise. +# The paramter is the name of the module. +sub create { + my $class = shift; + my ($name, $filename) = @_; + my $self = { + '_name' => $name, + '_shutdown' => 0, # see unload() + '_static' => 0, # set to 1 to prevent module being unloaded + '_variables' => {}, + '_config' => {}, + '_filename' => $filename, + '_filemodificationtime' => undef, + }; + bless($self, $class); + $self->Initialise(); + $self->RegisterConfig(); + return $self; +} + +sub DESTROY { + my $self = shift; + $self->debug('garbage collected'); +} + +# called by &::UnloadModule(). +# this removes any pointers to the module. +# for example, it stops the scheduler from installing new timers, +# so that the bot [eventually] severs its connection with the module. +sub unload { + my $self = shift; + $self->{'_shutdown'} = 1; # see doScheduled and bot_select +} + +# configStructure - return the hash needed for Configuration module +sub configStructure { + my $self = shift; + return $self->{'_config'}; +} + +# do - called to do anything (duh) (no, do, not duh) (oh, ok, sorry) +sub do { + my $self = shift; + my ($bot, $event, $type, $e) = @_; + # first, we check that the user is not banned from using this module. If he + # is, then re give up straight away. + return 1 if ($self->IsBanned($e)); + # next we check that the module is actually enabled in this channel, and + # if it is not we quit straight away as well. + return 1 unless ($e->{'channel'} eq '') or ($self->InChannel($e)); + # Ok, dispatch the event. + if ($type eq 'Told') { + return $self->Told($e, $e->{'data'}); + } elsif ($type eq 'Heard') { + return $self->Heard($e, $e->{'data'}); + } elsif ($type eq 'Baffled') { + return $self->Baffled($e, $e->{'data'}); + } elsif ($type eq 'Felt') { + return $self->Felt($e, $e->{'data'}); + } elsif ($type eq 'Saw') { + return $self->Saw($e, $e->{'data'}); + } elsif ($type eq 'Invited') { + return $self->Invited($e, $e->{'data'}); + } elsif ($type eq 'Kicked') { + return $self->Kicked($e, $e->{'channel'}); + } elsif ($type eq 'ModeChange') { + return $self->ModeChange($e, $e->{'channel'}, $e->{'data'}, $e->{'from'}); + } elsif ($type eq 'Authed') { + return $self->Authed($e, $e->{'from'}); + } elsif ($type eq 'SpottedNickChange') { + return $self->SpottedNickChange($e, $e->{'from'}, $e->{'data'}); + } elsif ($type eq 'SpottedTopicChange') { + return $self->SpottedTopicChange($e, $e->{'channel'}, $e->{'data'}); + } elsif ($type eq 'SpottedJoin') { + return $self->SpottedJoin($e, $e->{'channel'}, $e->{'from'}); + } elsif ($type eq 'SpottedPart') { + return $self->SpottedPart($e, $e->{'channel'}, $e->{'from'}); + } elsif ($type eq 'SpottedKick') { + return $self->SpottedKick($e, $e->{'channel'}, $e->{'data'}); + } elsif ($type eq 'SpottedQuit') { + return $self->SpottedQuit($e, $e->{'from'}, $e->{'data'}); + + # XXX have not implemented mode parsing yet + } elsif ($type eq 'GotOpped') { + return $self->GotOpped($e, $e->{'channel'}, $e->{'from'}); + } elsif ($type eq 'GotDeopped') { + return $self->GotDeopped($e, $e->{'channel'}, $e->{'from'}); + } elsif ($type eq 'SpottedOpping') { + return $self->SpottedOpping($e, $e->{'channel'}, $e->{'from'}); + } elsif ($type eq 'SpottedDeopping') { + return $self->SpottedDeopping($e, $e->{'channel'}, $e->{'from'}); + } else { + $self->debug("Unknown action type '$type'. Ignored."); + # UModeChange, Version, Source - XXX + return 1; # could not do it } - return "$sign$orignum"; } +# MODULE API - use these from the your routines. -sub ReportStock { - my ($nick, $name, $title) = (@_); - if ($title ne "") { - $title .= ": "; +# prints output to the console +sub debug { + my $self = shift; + foreach my $line (@_) { + &::debug('Module '.$self->{'_name'}.': '.$line); } - my $ref = $stockvals{$name}; - my $a = FracStr($ref->[0], 0); - my $b = FracStr($ref->[3], 1); - sendmsg($nick, "$title$name at $a ($b)"); } -sub bot_stocks { - my ($nick, $cmd, $rest) = (@_); - foreach my $name (sort(keys %stocklist)) { - foreach my $who (@{$stocklist{$name}}) { - if ($who eq $nick || $who eq $channel) { - ReportStock($nick, $name, ""); +# saveConfig - call this when you change a configuration option. It resaves the config file. +sub saveConfig { + my $self = shift; + &Configuration::Save($cfgfile, $self->configStructure()); +} + +# registerVariables - Registers a variable with the config system and the var setting system +# parameters: ( +# [ 'name', persistent ? 1:0, editable ? 1:0, $value ], +# use undef instead of 0 or 1 to leave as is +# use undef (or don't mention) the $value to not set the value +# ) +sub registerVariables { + my $self = shift; + my (@variables) = @_; + foreach (@variables) { + $self->{$$_[0]} = $$_[3] if defined($$_[3]); + if (defined($$_[1])) { + if ($$_[1]) { + $self->{'_config'}->{$self->{'_name'}.'::'.$$_[0]} = \$self->{$$_[0]}; + } else { + delete($self->{'_config'}->{$self->{'_name'}.'::'.$$_[0]}); + } + } + $self->{'_variables'}->{$$_[0]} = $$_[2] if defined($$_[2]); + } +} + +# internal implementation of the scheduler +sub doScheduled { + my $bot = shift; + my ($self, $event, $time, $times, @data) = @_; + return if ($self->{'_shutdown'}); # see unload() + # $self->debug("scheduled event occured; $times left @ $time second interval"); + eval { + $self->Scheduled($event, @data); + $self->schedule($event, $time, --$times, @data); + }; + if ($@) { + # $@ contains the error + &::debug("ERROR!!!", $@); + } +} + +# schedule - Sets a timer to call Scheduled later +# for events that should be setup at startup, call this from Schedule(). +sub schedule { + my $self = shift; + my ($event, $time, $times, @data) = @_; + return if ($times == 0 or $self->{'_shutdown'}); # see unload() + $times = -1 if ($times < 0); # pass a negative number to have a recurring timer + my $delay = $time; + if (ref($time)) { + if (ref($time) eq 'SCALAR') { + $delay = $$time; + } else { + return; # XXX maybe be useful? + } + } + # if ($delay < 1) { + # $self->debug("Vetoed aggressive scheduling; forcing to 1 second minimum"); + # $delay = 1; + # } + $event->{'bot'}->schedule($delay, \&doScheduled, $self, $event, $time, $times, @data); +} + +# spawnChild - spawns a child process and adds it to the list of file handles to monitor +# eventually the bot calls ChildCompleted() with the output of the chlid process. +sub spawnChild { + my $self = shift; + my ($event, $command, $arguments, $type, $data) = @_; + # uses IO::SecurePipe and fork and exec + # secure, predictable, no dependencies on external code + # uses fork explicitly (and once implicitly) + my $pipe = IO::SecurePipe->new(); + if (defined($pipe)) { + my $child = fork(); + if (defined($child)) { + if ($child) { + # we are the parent process + $pipe->reader(); + ${$pipe}->{'BotModules_Module'} = $self; + ${$pipe}->{'BotModules_Event'} = $event; + ${$pipe}->{'BotModules_ChildType'} = $type; + ${$pipe}->{'BotModules_Data'} = $data; + ${$pipe}->{'BotModules_Command'} = $command; + ${$pipe}->{'BotModules_Arguments'} = $arguments; + ${$pipe}->{'BotModules_PID'} = $child; + $irc->addfh($pipe, \&::bot_select); + local $" = ' '; + $self->debug("spawned $child ($command @$arguments)"); + return 0; + } else { + eval { + # we are the child process + # call $command and buffer the output + $pipe->writer(); # get writing end of pipe, ready to output the result + my $output; + if (ref($command) eq 'CODE') { + $output = &$command(@$arguments); + } else { + # it would be nice if some of this was on a timeout... + my $result = IO::SecurePipe->new(); # create a new pipe for $command + # call $command (implicit fork(), which may of course fail) + $result->reader($command, @$arguments); + local $/; # to not affect the rest of the program (what little there is) + $/ = \(2*1024*1024); # slurp up to two megabytes + $output = <$result>; # blocks until child process has finished + close($result); # reap child + } + print $pipe $output if ($output); # output the lot in one go back to parent + $pipe->close(); + }; + if ($@) { + # $@ contains the error + $self->debug('failed to spawn child', $@); + } + + # -- #mozwebtools was here -- + # when is that stupid bot going to get checked in? + # after it stops fork bombing + # which one? yours or hixies? + # his, mine doesn't fork + # see topic + # are there plans to fix it? + # yes. but he isn't sure exactly what went wrong + # i think it's basically they fork for wget + # why don't you help him? + # i don't understand forking + # that didn't stop hixie + # not to mention the fact that his forking doesn't + # work on windows + # you have other machines. techbot1 runs on windows? + # yeah it runs on windows + # oh + # get a real os, man + + # The bug causing the 'fork bombing' was that I only + # did the following if $@ was true or if the call to + # 'reader' succeeded -- so if some other error occured + # that didn't trip the $@ test but still crashed out + # of the eval, then the script would quite happily + # continue, and when it eventually died (e.g. because + # of a bad connection), it would respawn multiple + # times (as many times as it had failed to fork) and + # it would succeed in reconnecting as many times as + # had been configured nicks... + + eval { + exec { $0 } ($0, '--abort'); # do not call shutdown handlers + # the previous line works because exec() bypasses + # the perl object garbarge collection and simply + # deallocates all the memory in one go. This means + # the shutdown handlers (DESTROY and so on) are + # never called for this fork. This is good, + # because otherwise we would disconnect from IRC + # at this point! + }; + + $self->debug("failed to shutdown cleanly!!! $@"); + exit(1); # exit in case exec($0) failed + + } + } else { + $self->debug("failed to fork: $!"); + } + } else { + $self->debug("failed to open pipe: $!"); + } + return 1; +} + +# getURI - Downloads a file and then calls GotURI +sub getURI { + my $self = shift; + my ($event, $uri, @data) = @_; + $self->spawnChild($event, 'wget', ['--quiet', '--passive', '--user-agent="Mozilla/5.0 (compatible; mozbot)"', '--output-document=-', $uri], 'URI', [$uri, @data]); +} + +# returns a reference to a module -- DO NOT STORE THIS REFERENCE!!! +sub getModule { + my $self = shift; + return &::getModule(@_); +} + +# tellAdmin - may try to talk to an admin. +# NO GUARENTEES! This will PROBABLY NOT reach anyone! +sub tellAdmin { + my $self = shift; + my ($event, $data) = @_; + if ($lastadmin) { + $self->debug("Trying to tell admin '$lastadmin' this: $data"); + &::sendmsg($event->{'bot'}, $lastadmin, $data); + } else { + $self->debug("Wanted to tell an admin '$data', but I've never seen one."); + } +} + +# say - Sends a message to the channel +sub say { + my $self = shift; + my ($event, $data) = @_; + $data =~ s/^\Q$event->{'target'}\E: //gs; + &::sendmsg($event->{'bot'}, $event->{'target'}, $data); +} + +# announce - Sends a message to every channel +sub announce { + my $self = shift; + my ($event, $data) = @_; + foreach (@{$self->{'channels'}}) { + &::sendmsg($event->{'bot'}, $_, $data); + } +} + +# directSay - Sends a message to the person who spoke +sub directSay { + my $self = shift; + my ($event, $data) = @_; + &::sendmsg($event->{'bot'}, $event->{'from'}, $data); +} + +# channelSay - Sends a message to the channel the message came from, IFF it came from a channel. +sub channelSay { + my $self = shift; + my ($event, $data) = @_; + &::sendmsg($event->{'bot'}, $event->{'channel'}, $data) if $event->{'channel'}; +} + +# -- #mozilla was here -- +# timeless: it's focal review time, and they are working out +# where to allocate the money. +# timeless: needless to say i have a vested interest in this. +# there's money in this? +# richb yes; leaf always +# how come nobody told me? +# because leaf doesn't need money +# for leaf it grows on trees +# *wince* + +# emote - Sends an emote to the channel +sub emote { + my $self = shift; + my ($event, $data) = @_; + &::sendmsg($event->{'bot'}, $event->{'target'}, $data, 'me'); +} + +# directEmote - Sends an emote to the person who spoke +sub directEmote { + my $self = shift; + my ($event, $data) = @_; + &::sendmsg($event->{'bot'}, $event->{'from'}, $data, 'me'); +} + +# sayOrEmote - calls say() or emote() depending on whether the string starts with /me or not. +sub sayOrEmote { + my $self = shift; + my ($event, $data) = @_; + if ($data =~ /^\/me\s+/osi) { + $data =~ s/^\/me\s+//gosi; + $self->emote($event, $data); + } else { + $self->say($event, $data); + } +} + +# directSayOrEmote - as sayOrEmote() but calls the direct versions instead +sub directSayOrEmote { + my $self = shift; + my ($event, $data) = @_; + if ($data =~ /^\/me\s+/osi) { + $data =~ s/^\/me\s+//gosi; + $self->directEmote($event, $data); + } else { + $self->directSay($event, $data); + } +} + +# isAdmin - Returns true if the person is an admin +sub isAdmin { + my $self = shift; + my ($event) = @_; + return (($event->{'userName'}) and (($event->{'userFlags'} & 1) == 1)); +} + +# setAway - 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!!! +sub setAway { + my $self = shift; + my ($event, $message) = @_; + $event->{'bot'}->away($message); +} + +# setNick - Set the bot's nick. +# Note: Best not to use this too much, especially not based on user input, +# as it is not throttled. XXX +sub setNick { + my $self = shift; + my ($event, $value) = @_; + # Find nick's index. + my $newnick = 0; + $newnick++ while (($newnick < @nicks) and ($value ne $nicks[$newnick])); + # If nick isn't there, add it. + if ($newnick >= @nicks) { + push(@nicks, $value); + } + # set variable + $nick = $newnick; + $event->{'bot'}->nick($nicks[$nick]); + # save + &Configuration::Save($cfgfile, &::configStructure(\$nick, \@nicks)); +} + +sub mode { + my $self = shift; + my ($event, $channel, $mode, $arg) = @_; + $event->{'bot'}->mode($channel, $mode, $arg); +} + +sub invite { + my $self = shift; + my ($event, $who, $channel) = @_; + $event->{'bot'}->invite($who, $channel); +} + +# pretty printer for turning lists of varying length strings into +# lists of roughly equal length strings without losing any data +sub prettyPrint { + my $self = shift; + my ($preferredLineLength, $prefix, $indent, $divider, @input) = @_; + # sort numerically descending by length + @input = sort {length($b) <=> length($a)} @input; + # if we have a prefix defined, it goes first (duh) + unshift(@input, $prefix) if defined($prefix); + my @output; + my $index; + while (@input) { + push(@output, $indent . shift(@input)); + $index = 0; + while (($index <= $#input) and + ((length($output[$#output]) + length($input[$#input])) < $preferredLineLength)) { + # does this one fit? + if ((length($output[$#output]) + length($input[$index])) < $preferredLineLength) { + if (defined($prefix)) { + # don't stick the divider between the prefix and the first item + undef($prefix); + } else { + $output[$#output] .= $divider; + } + $output[$#output] .= splice(@input, $index, 1); + } else { + $index++; } } } + return @output; } -sub bot_pub_stocks { - my ($nick, $cmd, $rest) = (@_); - bot_stocks($::speaker, $cmd, $rest); - sendmsg($nick, "[ Stocks sent to $::speaker. In the future, use \"/msg mozbot stocks\" ]"); -} - -sub translate_usage { - my ($nick) = (@_); - sendmsg($nick, "Usage: translate (to|from) (en|fr|pt|it|de) sentence"); -} - -sub bot_translate { - my ($nick, $cmd, $rest) = (@_); - my ($dir, $lang, @words) = split(/ +/, $rest); - if ($dir ne "to" && $dir ne "from") { - return translate_usage($nick); +# wordWrap routines which takes a list and wraps it. A less pretty version +# of prettyPrinter, but it keeps the order. +sub wordWrap { + my $self = shift; + my ($preferredLineLength, $prefix, $indent, $divider, @input) = @_; + unshift(@input, $prefix) if defined($prefix); + my @output; + while (@input) { + push(@output, $indent . shift(@input)); + while (($#input >= 0) and + ((length($output[$#output]) + length($input[0])) < $preferredLineLength)) { + $output[$#output] .= $divider . shift(@input); + } } - my $result = babel::babelfish($dir, $lang, join(' ', @words)); - if ($result ne '') { - sendmsg($nick, $result); + return @output; +} + +sub unescapeXML { + my $self = shift; + my ($string) = @_; + $string =~ s/'/'/gos; + $string =~ s/"/"/gos; + $string =~ s/<//gos; + $string =~ s/&/&/gos; + return $string; +} + +sub days { + my $self = shift; + my ($then) = @_; + return &::days($then); +} + +# return the argument if it is a valid regular expression, +# otherwise quotes the argument and returns that. +sub sanitizeRegexp { + my $self = shift; + my ($regexp) = @_; + if (defined($regexp)) { + eval { + '' =~ /$regexp/; + }; + $self->debug("regexp |$regexp| returned error |$@|, quoting...") if $@; + return $@ ? quotemeta($regexp) : $regexp; } else { - translate_usage($nick); + $self->debug("blank regexp, returning wildcard regexp //..."); + return ''; } } -sub bot_review { - my ($nick, $cmd, $rest) = (@_); - sendmsg($nick, "$::speaker, I've reviewed your code, and it looks great. r=mozbot."); + +# MODULE INTERFACE (override these) + +# Initialise - Called when the module is loaded +sub Initialise { + my $self = shift; +} + +# Schedule - Called after bot is set up, to set up any scheduled tasks +# 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) = @_; +} + +# JoinedIRC - Called before joining any channels (but after module is setup) +# this does not get called for dynamically loaded modules +sub JoinedIRC { + my $self = shift; + my ($event) = @_; +} + +sub JoinedChannel { + my $self = shift; + my ($event, $channel) = @_; + if ($self->{'autojoin'}) { + push(@{$self->{'channels'}}, $channel) unless ((scalar(grep($_ eq $channel, @{$self->{'channels'}}))) or + (scalar(grep($_ eq $channel, @{$self->{'channelsBlocked'}})))); + $self->saveConfig(); + } } -sub bot_approve { - my ($nick, $cmd, $rest) = (@_); - - # be sneaky, and only respond some of the time. - my $randval = rand(); - if ($randval < .3) { - if ($randval < .1) - { sendmsg($nick, "\"as if.\""); } - elsif ($randval < .2) - { sendmsg($nick, "rheeeeeeeet!"); } - elsif ($randval < .3) { - my $approveRand = rand(); - my $approver; - - if ($approveRand < .2) { $approver = "marca\@ncsa.uiuc.edu"; } - elsif ($approveRand < .4) { $approver = "billg\@microsoft.com"; } - else { $approver = "mozbot"; } - sendmsg($nick, "$::speaker, your code is an byzantine workaround for a longstanding hack, but we need it to ship. a=$approver."); +sub PartedChannel { + my $self = shift; + my ($event, $channel) = @_; + if ($self->{'autojoin'}) { + my %channels = map { $_ => 1 } @{$self->{'channels'}}; + if ($channels{$channel}) { + delete($channels{$channel}); + @{$self->{'channels'}} = keys %channels; + $self->saveConfig(); + } + } +} + +sub InChannel { + my $self = shift; + my ($event) = @_; + return scalar(grep($_ eq $event->{'channel'}, @{$self->{'channels'}})); + # XXX could be optimised - cache the list into a hash. +} + +sub IsBanned { + my $self = shift; + my ($event) = @_; + return 0 if scalar(grep({ $_ = $self->sanitizeRegexp($_); $event->{'user'} =~ /^$_$/ } @{$self->{'allowusers'}})); + return scalar(grep({ $_ = $self->sanitizeRegexp($_); $event->{'user'} =~ /^$_$/ } @{$self->{'denyusers'}})); +} + +# Baffled - Called for messages prefixed by the bot's nick which we don't understand +sub Baffled { + my $self = shift; + my ($event, $message) = @_; + return 1; +} + +# Told - Called for messages prefixed by the bot's nick +sub Told { + my $self = shift; + my ($event, $message) = @_; + return 1; +} + +# Heard - Called for all messages +sub Heard { + my $self = shift; + my ($event, $message) = @_; + return 1; +} + +# Felt - Called for all emotes containing bot's nick +sub Felt { + my $self = shift; + my ($event, $message) = @_; + return 1; +} + +# -- #mozilla was here -- +# * bryner tries to imagine the need for NS_TWIPS_TO_MILES +# bryner: yeah, that isn't even a metric unit. should +# be NS_TWIPS_TO_KILOMETERS +# there's that too +# oh +# really? +# yep +# o_O +# for when we use mozilla for surveying and such +# lol + +# BTW. They aren't kidding. See: +# http://lxr.mozilla.org/seamonkey/search?string=NS_TWIPS_TO_KILOMETERS + +# Saw - Called for all emotes +sub Saw { + my $self = shift; + my ($event, $message) = @_; + return 1; +} + +# Invited - Called when bot is invited into another channel +sub Invited { + my $self = shift; + my ($event, $channel) = @_; + return 1; +} + +# Kicked - Called when bot is kicked out of a channel +sub Kicked { + my $self = shift; + my ($event, $channel) = @_; + return 1; +} + +# ModeChange - Called when channel or bot has a mode flag changed +sub ModeChange { + my $self = shift; + my ($event, $what, $change, $who) = @_; + return 1; +} + +# GotOpped - Called when bot is opped +sub GotOpped { + my $self = shift; + my ($event, $channel, $who) = @_; + return 1; +} + +# GotDeopped - Called when bot is deopped +sub GotDeopped { + my $self = shift; + my ($event, $channel, $who) = @_; + return 1; +} + +# SpottedNickChange - Called when someone changes their nick +# Remember that 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... XXX +sub SpottedNickChange { + my $self = shift; + my ($event, $from, $to) = @_; + return 1; +} + +# Authed - Called when someone authenticates with us. +# Remember that you cannot use say here, since this +# cannot actually be done in a channel... +sub Authed { + my $self = shift; + my ($event, $who) = @_; + return 1; +} + +# SpottedTopicChange - Called when someone thinks someone else said something funny +sub SpottedTopicChange { + my $self = shift; + my ($event, $channel, $new) = @_; + return 1; +} + +# SpottedJoin - Called when someone joins a channel +sub SpottedJoin { + my $self = shift; + my ($event, $channel, $who) = @_; + return 1; +} + +# SpottedPart - Called when someone leaves a channel +sub SpottedPart { + my $self = shift; + my ($event, $channel, $who) = @_; + return 1; +} + +# SpottedKick - Called when someone leaves a channel forcibly +sub SpottedKick { + my $self = shift; + my ($event, $channel, $who) = @_; + return 1; +} + +# SpottedQuit - Called when someone leaves a server +# can't use say or directSay: no channel involved, and +# user has quit (obviously). XXX +sub SpottedQuit { + my $self = shift; + my ($event, $who, $why) = @_; + return 1; +} + +# SpottedOpping - Called when someone is opped +sub SpottedOpping { + my $self = shift; + my ($event, $channel, $who) = @_; + return 1; +} + +# SpottedDeopping - Called when someone is... deopped, maybe? +sub SpottedDeopping { + my $self = shift; + my ($event, $channel, $who) = @_; + return 1; +} + +# Scheduled - Called when a scheduled timer triggers +sub Scheduled { + my $self = shift; + my ($event, @data) = @_; + if (ref($data[0]) eq 'CODE') { + &{$data[0]}($event, @data); + } else { + $self->debug('Unhandled scheduled event... :-/'); + } +} + +# ChildCompleted - Called when a child process has quit +sub ChildCompleted { + my $self = shift; + my ($event, $type, $output, @data) = @_; + if ($type eq 'URI') { + my $uri = shift(@data); + $self->GotURI($event, $uri, $output, @data); + } +} + +# GotURI - Called when a requested URI has been downloaded +sub GotURI { + my $self = shift; + my ($event, $uri, $contents, @data) = @_; +} + +# Help - Called to fully explain the module (return hash of command/description pairs) +# the string given for the '' key should be a module description +sub Help { + my $self = shift; + my ($event) = @_; + return {}; +} + +# RegisterConfig - Called when initialised, should call registerVariables +sub RegisterConfig { + my $self = shift; + $self->registerVariables( + # [ name, save?, settable?, value ] + ['channels', 1, 1, []], + ['channelsBlocked', 1, 1, []], # the channels in which this module will not autojoin regardless + ['autojoin', 1, 1, 1], + ['allowusers', 1, 1, []], + ['denyusers', 1, 1, []], + ); +} + +# Set - called to set a variable to a particular value. +sub Set { + my $self = shift; + my ($event, $variable, $value) = @_; + if ($self->{'_variables'}->{$variable}) { + if ((not defined($self->{$variable})) or (not ref($self->{$variable}))) { + $self->{$variable} = $value; + } elsif (ref($self->{$variable}) eq 'SCALAR') { + ${$self->{$variable}} = $value; + } elsif (ref($self->{$variable}) eq 'ARRAY') { + if ($value =~ /^([-+])(.*)$/so) { + if ($1 eq '+') { + push(@{$self->{$variable}}, $2); + } else { + # We don't want to change the reference!!! + # Other variables might be pointing to there, + # it is *those* vars that affect the app. + my @oldvalue = @{$self->{$variable}}; + @{$self->{$variable}} = (); + foreach (@oldvalue) { + push(@{$self->{$variable}}, $_) unless ($2 eq $_); + } + # XXX no feedback if nothing is done + } + } else { + return 3; # not the right format dude! + } + } elsif (ref($self->{$variable}) eq 'HASH') { + if ($value =~ /^\+(.)(.*)\1(.*)$/so) { + $self->{$variable}->{$2} = $3; + return -2 if $1 =~ /[a-zA-Z]/os; + } elsif ($value =~ /^\-(.*)$/so) { + # XXX no feedback if nothing is done + delete($self->{$variable}->{$1}); + } else { + return 4; # not the right format dude! + } + } else { + return 1; # please to not be trying to set coderefs or arrayrefs or hashrefs or ... } } else { - do_unknown($nick, $cmd, $rest); + return 2; # please to not be trying to set variables I not understand! + } + $self->saveConfig(); + return 0; +} + +# Get - called to get a particular variable +sub Get { + my $self = shift; + my ($event, $variable) = @_; + return $self->{$variable}; +} + +# Log - Called for every event +sub Log { + my $self = shift; + my ($event) = @_; +} + + +################################ +# Admin Module # +################################ + +package BotModules::Admin; +use vars qw(@ISA); +@ISA = qw(BotModules); +1; + +# Initialise - Called when the module is loaded +sub Initialise { + my $self = shift; + $self->{'_fileModificationTimes'} = {}; + $self->{'_static'} = 1; +} + +# RegisterConfig - Called when initialised, should call registerVariables +sub RegisterConfig { + my $self = shift; + $self->SUPER::RegisterConfig(@_); + $self->registerVariables( + # [ name, save?, settable?, value ] + ['allowInviting', 1, 1, 1], # by default, anyone can invite a bot into their channel + ['allowChannelAdmin', 1, 1, 0], # by default, one cannot admin from a channel + ['sourceCodeCheckDelay', 1, 1, 20], # by default, wait 20 seconds between source code checks + ['files', 1, 1, [$0]], # files to check for source code changes + ['channels', 0, 0, undef], # remove the 'channels' internal variable... + ['autojoin', 0, 0, 0], # remove the 'autojoin' internal variable... + ['errorMessagesMaxLines', 1, 1, 5], # by default, only have 5 lines in error messages, trim middle if more + ); + # now add in all the global variables... + foreach (keys %configStructure) { + $self->registerVariables([$configStructure{$_}[0], 0, 1, $configStructure{$_}[1]]) if (ref($configStructure{$_}[1]) =~ /^(?:SCALAR|ARRAY|HASH)$/go); } } -sub trim { - ($_) = (@_); - s/^\s+//g; - s/\s+$//g; - return $_; +# saveConfig - make sure we also save the main config variables... +sub saveConfig { + my $self = shift; + $self->SUPER::saveConfig(@_); + &Configuration::Save($cfgfile, &::configStructure()); +} + +# Set - called to set a variable to a particular value. +sub Set { + my $self = shift; + my ($event, $variable, $value) = @_; + # First let's special case some magic variables... + if ($variable eq 'currentnick') { + $self->setNick($event, $value); + return -1; + } else { + return $self->SUPER::Set($event, $variable, $value); + } +} + +# Get - called to get a particular variable. +sub Get { + my $self = shift; + my ($event, $variable) = @_; + # First let's special case some magic variables... + if ($variable eq 'currentnick') { + return $event->{'bot'}->nick(); # at this point, $event->{'nick'} would work too + } elsif ($variable eq 'users') { + my @users = sort keys %users; + return \@users; + } else { + # else, check for known global variables... + my $configStructure = &::configStructure(); + if (defined($configStructure->{$variable})) { + return $configStructure->{$variable}; + } else { + return $self->SUPER::Get($event, $variable); + } + } +} + +# 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->{'sourceCodeCheckDelay'}, -1, {'action'=>'source'}); + $self->SUPER::Schedule($event); +} + +sub InChannel { + my $self = shift; + my ($event) = @_; + return $self->{'allowChannelAdmin'}; +} + +sub Help { + my $self = shift; + my ($event) = @_; + if ($self->isAdmin($event)) { + return { + '' => 'The administration module is used to perform tasks that fundamentally affect the bot.', + 'shutdown' => 'Shuts the bot down completely.', + 'shutup' => 'Clears the output queue (you actually have to say \'shutup please\' or nothing will happen).', + 'restart' => 'Shuts the bot down completely then restarts it, so that any source changes take effect.', + 'cycle' => 'Makes the bot disconnect from the server then try to reconnect.', + 'vars' => 'Manage variables: vars [ [ [\'\']]], say \'vars\' for more details.', + 'join' => 'Makes the bot attempt to join a channel. You can also use /invite. Syntax: join ', + 'part' => 'Makes the leave a channel. The same affect can be achieved using /kick. Syntax: part ', + 'load' => 'Loads a module from disk, if it is not already loaded: load ', + 'unload' => 'Unloads a module from memory: load ', + 'reload' => 'Unloads and then loads a module: reload ', + 'bless' => 'Sets the \'admin\' flag on a registered user. Syntax: bless ', + 'unbless' => 'Resets the \'admin\' flag on a registered user. Syntax: unbless ', + }; + } else { + return {}; + } +} + +# Told - Called for messages prefixed by the bot's nick +sub Told { + my $self = shift; + my ($event, $message) = @_; + if ($self->isAdmin($event)) { + if ($message =~ /^\s*(?:shutdown,?\s+please)\s*[?!.]*\s*$/osi) { + $self->say($event, 'But of course. Have a nice day!'); + $event->{'bot'}->quit('I was told to shutdown by '.$event->{'from'}.'. :-('); + exit(0); # prevents any other events happening... + } elsif ($message =~ /^\s*shutdown/osi) { + $self->say($event, 'If you really want me to shutdown, use the magic word.'); + $self->schedule($event, 7, 1, 'i.e., please.'); + } elsif ($message =~ /^\s*(?:restart,?\s+please)\s*[?!.]*\s*$/osi) { + $self->Restart($event, "I was told to restart by $event->{'from'} -- brb"); + } elsif ($message =~ /^\s*restart/osi) { + $self->say($event, 'If you really want me to restart, use the magic word.'); + $self->schedule($event, 7, 1, 'i.e., please.'); + } elsif ($message =~ /^\s*(?:shutup,?\s+please)\s*[?!.]*\s*$/osi) { + my $lost = @msgqueue; + @msgqueue = (); + if ($lost) { + $self->say($event, "Ok, threw away $lost messages."); + } else { + $self->say($event, 'But I wasn\'t saying anything!'); + } + } elsif ($message =~ /^\s*cycle(?:\s+please)?\s*[?!.]*\s*$/osi) { + $event->{'bot'}->quit('I was told to cycle by '.$event->{'from'}.'. BRB!'); + &Configuration::Get($cfgfile, &::configStructure()); + } elsif ($message =~ /^\s*join\s+([&#+][^\s]+)(?:\s+please)?\s*[?!.]*\s*$/osi) { + $self->Invited($event, $1); + } elsif ($message =~ /^\s*part\s+([&#+][^\s]+)(?:\s+please)?\s*[?!.]*\s*$/osi) { + $self->Kicked($event, $1); + } elsif ($message =~ /^\s*bless\s+('?)($variablepattern)\1\s*$/osi) { + if (defined($users{$2})) { + $userFlags{$2} = $userFlags{$2} || 1; + $self->saveConfig(); + $self->say($event, "Ok, $2 is now an admin."); + } else { + $self->say($event, 'I don\'t know that user. Try the \'newuser\' command (see \'help newuser\' for details).'); + } + } elsif ($message =~ /^\s*unbless\s+('?)($variablepattern)\1\s*$/osi) { + if (defined($users{$2})) { + $userFlags{$2} = $userFlags{$2} &~ 1; + $self->saveConfig(); + $self->say($event, "Ok, $2 is now a mundane luser."); + } else { + $self->say($event, 'I don\'t know that user. Check your spelling!'); + } + } elsif ($message =~ /^\s*load\s+('?)($variablepattern)\1\s*$/osi) { + $self->LoadModule($event, $2, 1); + } elsif ($message =~ /^\s*reload\s+('?)($variablepattern)\1\s*$/osi) { + $self->ReloadModule($event, $2, 1); + } elsif ($message =~ /^\s*unload\s+('?)($variablepattern)\1\s*$/osi) { + $self->UnloadModule($event, $2, 1); + } elsif ($message =~ /^\s*vars(?:\s+($variablepattern)(?:\s+($variablepattern)(?:\s+'(.*)')?)?|(.*))?\s*$/osi) { + $self->Vars($event, $1, $2, $3, $4); + } else { + return $self->SUPER::Told(@_); + } + } else { + return $self->SUPER::Told(@_); + } + return 0; # if made it here then we did it! +} + +sub Scheduled { + my $self = shift; + my ($event, $type) = @_; + if ((ref($type) eq 'HASH') and ($type->{'action'} eq 'source')) { + $self->CheckSource($event); + } elsif (ref($type)) { + $self->SUPER::Scheduled(@_); + } else { + $self->directSay($event, $type); + } +} + +sub CheckSource { + my $self = shift; + my ($event) = @_; + foreach my $file (@{$self->{'files'}}) { + my $lastModificationTime = $self->{'_fileModificationTimes'}->{$file}; + my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime, $blksize, $blocks) + = stat($file); + $self->{'_fileModificationTimes'}->{$file} = $mtime; + if (defined($lastModificationTime) and ($mtime > $lastModificationTime)) { + $self->debug("Noticed that source code of $file had changed"); + # compile new bot using perl -cwT XXX + if (1) { # XXX replace 1 with "did compile succeed" test + $self->Restart($event, 'someone seems to have changed my source code. brb, unless I get a compile error!'); + } else { + # tellAdmin that it did not compile XXX + # debug that it did not compile + } + } + } + my @updatedModules; + foreach my $module (@modules) { + if ($module->{'_filename'}) { + my $lastModificationTime = $module->{'_fileModificationTime'}; + my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime, $blksize, $blocks) + = stat($module->{'_filename'}); + $module->{'_fileModificationTime'} = $mtime; + if (defined($lastModificationTime) and ($mtime > $lastModificationTime)) { + push(@updatedModules, $module->{'_name'}); + } + } + } + foreach my $module (@updatedModules) { + $self->ReloadModule($event, $module, 0); + } +} + +sub Restart { + my $self = shift; + my ($event, $reason) = @_; + $event->{'bot'}->quit($reason); + # Note that `exec' will not call our `END' blocks, nor will it + # call any `DESTROY' methods in our objects. So we fork a child to + # do that first. + my $parent = $$; + my $child = fork(); + if (defined($child)) { + if ($child) { + # we are the parent process who is + # about to exec($0), so wait for + # child to shutdown. + $self->debug("spawned $child to handle shutdown..."); + waitpid($child, 0); + } else { + # we are the child process who is + # in charge of shutting down cleanly. + $self->debug("initiating shutdown for parent process $parent..."); + exit(0); + } + } else { + $self->debug("failed to fork: $!"); + } + $self->debug("About to defer to a new $0 process..."); + # we have done our best to shutdown, so go for it! + eval { + if ($CHROOT) { + exec { $0 } ($0, '--assume-chrooted', $cfgfile); + } else { + exec { $0 } ($0, $cfgfile); + } + # I am told (by some nice people in #perl on Efnet) that our + # memory is all cleared up for us. So don't worry that even + # though we don't call DESTROY in _this_ instance, we leave + # memory behind. + }; + $self->debug("That failed!!! Bailing out to prevent all hell from breaking loose! $@ :-|"); + exit(1); # we never get here unless exec fails +} + +# handles the 'vars' command +sub Vars { + my $self = shift; + my ($event, $modulename, $variable, $value, $nonsense) = @_; + if (defined($modulename)) { + my $module = $self->getModule($modulename); + if (defined($module)) { + if (defined($variable)) { + if (defined($value)) { + my $result = $module->Set($event, $variable, $value); + if ((not defined($result)) or ($result == 0)) { + $self->say($event, "Variable '$variable' in module '$modulename' has changed."); + } elsif ($result == 1) { + $self->say($event, "Variable '$variable' is of type ".ref($module->{$variable}).' and I do not know how to set that kind of variable!'); + } elsif ($result == 2) { # we don't know that variable! + if ($module->{$variable}) { # well we do, but only to read + $self->say($event, "Variable '$variable' in module '$modulename' is read-only, sorry."); + } else { # not known + $self->say($event, "Module '$modulename' does not have a variable '$variable' as far as I can tell."); + } + } elsif ($result == 3) { + $self->say($event, "Variable '$variable' is a list. To add to a list, please use the '+' symbol before the value (vars '+'). To remove from a list, use the '-' symbol (vars '-')."); + } elsif ($result == 4) { + $self->say($event, "Variable '$variable' is a hash. To add to a hash, please use the '+' symbol before the '|key|value' pair (vars '+||'). The separator symbol ('|' in this example) could be anything. To remove from a list, use the '-' symbol (vars '-')."); + } elsif ($result == -1) { + # already reported success + } elsif ($result == -2) { + $self->say($event, "Variable '$variable' in module '$modulename' has changed, but may not be what you expect since it appears to me that you used a letter to delimit the sections. I hope that is what you meant to do..."); + } elsif ($result > 0) { # negative = success + $self->say($event, "Variable '$variable' in module '$modulename' could not be set for some reason unknown to me."); + } + } else { # else give variable's current value + $value = $module->Get($event, $variable); + if (defined($value)) { + my $type = ref($value); + if ($type eq 'SCALAR') { + $self->say($event, "Variable '$variable' in module '$modulename' is set to: '$$value'"); + } elsif ($type eq 'ARRAY') { + # XXX need a 'maximum number of items' feature to prevent flooding ourselves to pieces (or is shutup please enough?) + if (@$value) { + local $" = '\', \''; + $self->say($event, "Variable '$variable' in module '$modulename' is a list with the following values: '@$value'"); + } else { + $self->say($event, "Variable '$variable' in module '$modulename' is an empty list."); + } + } elsif ($type eq 'HASH') { + # XXX need a 'maximum number of items' feature to prevent flooding ourselves to pieces (or is shutup please enough?) + $self->say($event, "Variable '$variable' in module '$modulename' is a hash with the following values:"); + foreach (sort keys %$value) { + $self->say($event, " '$_' => '".($value->{$_}).'\' '); + } + $self->say($event, "End of dump of variable '$variable'."); + } else { + $self->say($event, "Variable '$variable' in module '$modulename' is set to: '$value'"); + } + } else { # we don't know that variable + if ($module->{'_variables'}->{$variable}) { # well we do, but only to write + $self->say($event, "Variable '$variable' in module '$modulename' is write-only, sorry."); + } else { # not known + $self->say($event, "Module '$modulename' does not have a variable '$variable' as far as I can tell."); + } + } + } + } else { # else list variables + my @variables; + # then enumerate its variables + foreach my $variable (sort keys %{$module->{'_variables'}}) { + push(@variables, $variable) if $module->{'_variables'}->{$variable}; + } + # then list 'em + if (@variables) { + local $" = '\', \''; + $self->say($event, "Module '$modulename' has the following published variables: '@variables'"); + } else { + $self->say($event, "Module '$modulename' has no settable variables."); + } + } + } else { # complain no module + $self->say($event, "I didn't recognise that module name ('$modulename'). Try just 'vars' on its own for help."); + } + } elsif ($nonsense) { + $self->say($event, 'I didn\'t quite understand that. Try just \'vars\' on its own for help.'); + $self->say($event, 'If you are trying to set a variable, don\'t forget the quotes around the value!'); + } else { # else give help + $self->say($event, 'The \'vars\' command gives you an interface to the module variables in the bot.'); + $self->say($event, 'To list the variables in a module: vars '); + $self->say($event, 'To get the value of a variable: vars '); + $self->say($event, 'To set the value of a variable: vars \'\''); + $self->say($event, 'Note the quotes around the value. They are required. If the value contains quotes itself, that is fine.'); + } +} + +# This is also called when we are messaged a 'join' command +sub Invited { + my $self = shift; + my ($event, $channelName) = @_; + # $channelName is the name as requested and as should be /joined. + # This is important so that case is kept in the list of channels + # on the server should the bot join first. + my $channel = lc($channelName); + if (grep($_ eq $channel, @channels)) { + $self->directSay($event, "I think already *in* channel $channel! If this is not the case please make me part and then rejoin."); + } else { + if ($self->isAdmin($event) || $self->{'allowInviting'}) { + $self->debug("Joining $channel, since I was invited."); + push(@channels, $channel); + $event->{'bot'}->join($channelName); + &Configuration::Save($cfgfile, &::configStructure(\@channels)); + $self->debug('about to autojoin modules...'); + foreach (@modules) { + $_->JoinedChannel($event, $channel); + } + } else { + $self->debug($event->{'from'}." asked me to join $channel, but I refused."); + $self->directSay($event, "Please contact one of my administrators if you want me to join $channel."); + $self->tellAdmin($event, "Excuse me, but ".$event->{'from'}." asked me to join $channel. I thought you should know."); + } + } + return $self->SUPER::Invited($event, $channel); +} + +# This is also called when we are /msg'ed a 'part' command +sub Kicked { + my $self = shift; + my ($event, $channel) = @_; + $channel = lc($channel); + my %channels = map { $_ => 1 } @channels; + if ($channels{$channel}) { + $self->debug("kicked from $channel by ".$event->{'from'}); + $event->{'bot'}->part($channel, 'I was told to leave by '.$event->{'from'}.'. :-('); + delete($channels{$channel}); + @channels = keys %channels; + &Configuration::Save($cfgfile, &::configStructure(\@channels)); + $self->debug('about to autopart modules...'); + foreach (@modules) { + $_->PartedChannel($event, $channel); + } + } else { + $self->directSay($event, "I'm not *in* channel $channel!"); + } + return $self->SUPER::Kicked($event, $channel); +} + +sub LoadModule { + my $self = shift; + my ($event, $name, $requested) = @_; + my $newmodule = &::LoadModule($name); + if (ref($newmodule)) { + # configure module + $newmodule->{'channels'} = [@channels]; + &Configuration::Get($cfgfile, $newmodule->configStructure()); + $newmodule->Schedule($event); + # ensure we don't add it if it is there already + push(@modulenames, $newmodule->{'_name'}) unless grep($_ eq $newmodule->{'_name'}, @modulenames); + $newmodule->saveConfig(); + &Configuration::Save($cfgfile, &::configStructure(\@modulenames)); + $self->debug("Successfully loaded module '$name'."); + if ($requested) { + $self->say($event, "Loaded module '$name'."); + } + } else { + if ($requested) { # it failed, $newmodule contains error message + my @errors = split(/[\n\r]/gos, $newmodule); + if (scalar(@errors) > $self->{'errorMessagesMaxLines'}) { + # remove lines from the middle if the log is too long + @errors = (@errors[0..int($self->{'errorMessagesMaxLines'} / 2)-1], '...', @errors[-(int($self->{'errorMessagesMaxLines'} / 2))..-1]); + } + local $" = "\n"; + $self->say($event, "@errors"); + } + $self->debug($newmodule); + } +} + +sub UnloadModule { + my $self = shift; + my ($event, $name, $requested) = @_; + my $result = &::UnloadModule($name); + if ($result) { # failed + if ($requested) { + $self->say($event, $result); + } else { + $self->debug($result); + } + } else { + my @newmodulenames; + foreach (@modulenames) { + push(@newmodulenames, $_) unless ($name eq $_); + } + @modulenames = @newmodulenames; + if ($requested) { + $self->say($event, "Unloaded module '$name'."); + } else { + $self->debug("Successfully unloaded module '$name'."); + } + &Configuration::Save($cfgfile, &::configStructure(\@modulenames)); + } +} + +sub ReloadModule { + my $self = shift; + # XXX there used to be a memory leak around this code. It seems to be fixed + # now. However if your bot process suddenly balloons to 90M+, here would be a good + # place to start looking. Of course if that happens and you never reloaded modules + # then it is also a good time to remove this comment... ;-) + $self->UnloadModule(@_); + $self->LoadModule(@_); } +################################ +# General Module # +################################ + +package BotModules::General; +use vars qw(@ISA); +@ISA = qw(BotModules); +1; + +# Initialise - Called when the module is loaded +sub Initialise { + my $self = shift; + $self->{'_static'} = 1; +} + +# RegisterConfig - Called when initialised, should call registerVariables +sub RegisterConfig { + my $self = shift; + $self->SUPER::RegisterConfig(@_); + $self->registerVariables( + # [ name, save?, settable?, value ] + ['channels', 0, 0, undef], # remove the 'channels' internal variable... + ['autojoin', 0, 0, 0], # remove the 'autojoin' internal variable... + ['preferredHelpLineLength', 1, 1, 70], + ); +} + +sub InChannel { + # my $self = shift; + # my ($event) = @_; + return 1; # always +} + +# saveConfig - make sure we also save the main config variables... +sub saveConfig { + my $self = shift; + $self->SUPER::saveConfig(@_); + &Configuration::Save($cfgfile, &::configStructure(\%users, \%userFlags)); +} + +sub Help { + my $self = shift; + my ($event) = @_; + return { + '' => 'The module that provides the bot-wide services.', + 'help' => 'Gives information about modules and commands. Syntax: help []', + 'auth' => 'Authenticate yourself: auth ', + 'password' => 'Change your password: password ', + 'newuser' => 'Registers a new username and password (with no privileges). Syntax: newuser ', + }; +} + +# Told - Called for messages prefixed by the bot's nick +sub Told { + my $self = shift; + my ($event, $message) = @_; + if ($message =~ /^\s*help(?:\s+($variablepattern))?[ ?!.]*\s*$/osi) { + if ($1) { + # display help for that command + # first, build the help file... + my %topicList; + foreach my $module (@modules) { + my $commands = $module->Help($event); + if ($commands->{''}) { + $topicList{lc($module->{'_name'})} = [] unless defined($topicList{lc($module->{'_name'})}); + push(@{$topicList{lc($module->{'_name'})}}, $commands->{''}); + } + foreach (keys %$commands) { + $topicList{lc($_)} = [] unless defined($topicList{lc($_)}); + push(@{$topicList{lc($_)}}, $commands->{lc($_)}); + } + } + if (defined($topicList{lc($1)})) { + foreach (@{$topicList{lc($1)}}) { + $self->say($event, "$1: $_"); + } + } else { + $self->say($event, "No help for topic '$1'."); + } + } else { + $self->directSay($event, "Help topics for $NAME $VERSION ($helpline):"); + $self->say($event, "$event->{'from'}: help info /msg'ed") if ($event->{'channel'}); + local @" = ', '; + my @helplist; + foreach my $module (@modules) { + my %commands = %{$module->Help($event)}; + my $moduleHelp = delete($commands{''}); + my @commands = sort keys %commands; + if (@commands) { + push(@helplist, "$module->{'_name'}: @commands"); + } elsif ($moduleHelp) { + push(@helplist, "$module->{'_name'}"); + } + } + foreach ($self->prettyPrint($self->{'preferredHelpLineLength'}, undef, ' ', '; ', @helplist)) { + $self->directSay($event, $_); + } + $self->directSay($event, 'For help on a particular topic, type \'help \'. Note that some commands may be disabled in certain channels.'); + } + } elsif ($message =~ /^\s*auth\s+($variablepattern)\s+($variablepattern)\s*$/osi) { + if (not $event->{'channel'}) { + if (defined($users{$1})) { + if (&::checkPassword($2, $users{$1})) { + $authenticatedUsers{$event->{'user'}} = $1; + $self->directSay($event, "Hi $1!"); + &::do($event->{'bot'}, $event->{'_event'}, 'Authed'); # hack hack hack + } else { + $self->directSay($event, "No..."); + } + } else { + $self->directSay($event, "You have not been added as a user yet. Try the \'newuser\' command (see \'help newuser\' for details)."); + } + } + } elsif ($message =~ /^\s*password\s+($variablepattern)\s+($variablepattern)\s+\2\s*$/osi) { + if (not $event->{'channel'}) { + if ($authenticatedUsers{$event->{'user'}}) { + if (&::checkPassword($1, $users{$authenticatedUsers{$event->{'user'}}})) { + $users{$authenticatedUsers{$event->{'user'}}} = &::newPassword($2); + $self->say($event, 'Password changed. Please reauthenticate.'); + $self->saveConfig(); + } else { + $self->say($event, 'That is not your current password. Please reauthenticate.'); + } + delete($authenticatedUsers{$event->{'user'}}); + } + } + } elsif ($message =~ /^\s*new\s*user\s+($variablepattern)\s+($variablepattern)\s+\2\s*$/osi) { + if (not $event->{'channel'}) { + if (defined($users{$1})) { + $self->say($event, 'That user already exists in my list, you can\'t add them again!'); + } elsif ($1) { + $users{$1} = &::newPassword($2); + $userFlags{$1} = 0; + $self->directSay($event, "New user '$1' added with password '$2' and no rights."); + $self->saveConfig(); + } else { + $self->say($event, 'That is not a valid user name.'); + } + } + } else { + return $self->SUPER::Told(@_); + } + return 0; # dealt with it, do nothing else +} + + +# remove any (other) temporary administrators when an admin authenticates +sub Authed { + my $self = shift; + my ($event, $who) = @_; + if ($self->isAdmin($event)) { + foreach (keys %userFlags) { + if ((($userFlags{$_} & 2) == 2) and ($authenticatedUsers{$event->{'user'}} ne $_)) { + delete($userFlags{$_}); + delete($users{$_}); + # if they authenticated, remove the entry to prevent dangling links + foreach my $user (keys %authenticatedUsers) { + if ($authenticatedUsers{$user} eq $_) { + delete($authenticatedUsers{$user}); + } + } + $self->directSay($event, "Temporary administrator '$_' removed from user list."); + $self->saveConfig(); + } + } + } + return $self->SUPER::Authed(@_); # this should not stop anything else happening +} + +# SpottedQuit - Called when someone leaves a server +sub SpottedQuit { + my $self = shift; + my ($event, $who, $why) = @_; + delete($authenticatedUsers{$event->{'user'}}); + return $self->SUPER::SpottedQuit(@_); +} + + +################################ +# Startup (aka main) # +################################ + +package main; + +# -- #mozilla was here -- +# is the bug with zilla hanging on startup on every +# platform fixed in today's nightlies? +# no +# heh +# NEVER +# we're shipping with it. +# helps hide our other bugs # Do this at the very end, so we can intersperse "my" initializations outside # of routines above and be assured that they will run. -$irc->start; +&debug('starting up command loop...'); + +END { &debug('perl is shutting down...'); } + +$irc->start(); + +# -- #mozilla was here -- +# Maybe I'll file a bug about netcenter and that will +# get some attention +# "Browser won't render home.netscape.com.. because it +# won't start up" +# alecf how about "cant view banner ads - wont start up" +# even better +# all bugs are dependent on this one! + +# *** Disconnected from irc.mozilla.org diff --git a/mozilla/webtools/mozbot/run-mozbot-chrooted b/mozilla/webtools/mozbot/run-mozbot-chrooted new file mode 100644 index 00000000000..5e242ab9cf6 --- /dev/null +++ b/mozilla/webtools/mozbot/run-mozbot-chrooted @@ -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.