1 # -*- Mode: perl; tab-width: 4; indent-tabs-mode: nil; -*-
2 ################################
4 ################################
6 package BotModules::Tinderbox;
11 # RegisterConfig - Called when initialised, should call registerVariables
14 $self->SUPER::RegisterConfig(@_);
15 $self->registerVariables(
16 # [ name, save?, settable? ]
17 ['trees', 1, 1, ['SeaMonkey', 'SeaMonkey-Ports', 'MozillaTest', 'Grendel']],
18 ['treesAnnounced', 1, 1, ['SeaMonkey', 'SeaMonkey-Ports']],
19 ['treesDefault', 1, 1, ['SeaMonkey']],
20 ['treeStates', 0, 0, {}], # ->tree->(current, previous, lastupdate)
21 ['lasttreesStates', 0, 0, []], # copy of trees in last test
22 ['tinderboxStates', 0, 0, {}], # ->tree->build->(current, previous, lastupdate)
23 ['updateDelay', 1, 1, 120],
24 ['useNotice', 1, 1, 1], # set to 1 to use notice and 0 to use a normal message
25 ['_lastupdate', 0, 0, 0],
26 ['preferredLineLength', 1, 1, 100],
27 ['mutes', 1, 1, {}], # tree -> "channel channel channel"
28 ['states', 1, 1, {'success' => 'Success', 'testfailed' => 'Test Failed', 'busted' => 'Burning', }],
29 ['maxInChannel', 1, 1, 5], # maximum number of lines to report in a channel
30 ['tinderboxURI', 1, 1, "http://tinderbox.mozilla.org/"], # base URL for Tinderbox
31 ['isTinderbox2', 1, 1, 0], # whether this is tinderbox2 or not
35 # Schedule - called when bot connects to a server, to install any schedulers
36 # use $self->schedule($event, $delay, $times, $data)
37 # where $times is 1 for a single event, -1 for recurring events,
38 # and a +ve number for an event that occurs that many times.
42 $self->schedule($event, \$self->{'updateDelay'}, -1, 'tinderbox');
43 $self->SUPER::Schedule($event);
50 '' => 'The Tinderbox module monitors who the state of the tinderboxen.',
51 'qt' => 'Quick trees, same as \'trees terse\'. You can give it a <tree> argument if you like, for example \'qt seamonkey\'.',
52 'builds' => 'Gives the status of all the builds in all the trees that match a particular pattern. Syntax: \'builds <build>\'. For example: \'builds Mac\'.',
53 'trees' => 'Reports on the current state of the tinderboxen. Syntax: \'trees <options> <tree>\' where <options> is any number of: '.
54 'all (show all trees and all builds), main (show only main trees), burning (show only burning builds), '.
55 'long, medium, short, terse (how much detail to include), and <tree> is the name of the tree to show (or a regexp matching it).',
57 if ($self->isAdmin($event)) {
58 $commands{'mute'} = 'Disable reporting of a tree in a channel. (Only does something if the given tree exists.) Syntax: mute tinderbox <tree> in <channel>';
59 $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 tinderbox <tree> in <channel>';
66 my ($event, $message) = @_;
67 if ($message =~ /^\s*trees?(?:\s+(.*?))?\s*(?:[, ]\s*please)?\?*\s*$/osi) {
70 my $trees = -1; # 0=default; 1=all; 'x'=pattern match
71 my $builds = -1; # 0=all; 1=horked and test failed; 2=horked only
72 my $verbosity = -1; # 1=terse; 2; 3; 4=verbose
76 foreach (split(/\s+/, $1)) {
77 if (/^all$/osi) { $trees = '1' if $trees < 0; $builds = 0 if $builds < 0; }
78 elsif (/^main$/osi) { $trees = '0'; }
79 elsif (/^burning$/osi) { $builds = 2; }
80 elsif (/^long$/osi) { $verbosity = 4; }
81 elsif (/^medium$/osi) { $verbosity = 3; }
82 elsif (/^short$/osi) { $verbosity = 2; }
83 elsif (/^terse$/osi) { $verbosity = 1; }
89 $trees = '0' if $trees < 0;
90 $builds = 1 if $builds < 0;
91 $verbosity = 2 if $verbosity < 0;
94 $self->GetTrees($event, 1, $trees, $builds, $verbosity);
96 } elsif ($message =~ /^\s*builds?\s+(.*?)\s*\?*\s*$/osi) {
97 $self->GetTrees($event, 2, $1);
98 } elsif ($message =~ /^\s*qt(?:\s+(.+?))?\s*$/osi) {
99 $self->GetTrees($event, 1, defined($1) ? $1 : 0, 1, 1);
100 } elsif ($self->isAdmin($event)) {
101 if ($message =~ /^\s*mute tinderbox\s+(\S+?)\s+in\s+(\S+?)\s*$/osi) {
102 my $tree = $1 eq 'Tinderbox' ? '' : $1;
103 my $treeName = $tree eq '' ? 'all trees' : "trees named $tree";
104 if (($tree eq '') or (grep $_ eq $tree, @{$self->{'trees'}})) {
105 $self->{'mutes'}->{$tree} .= " $2";
107 $self->say($event, "$event->{'from'}: Tinderbox notifications for $treeName muted in channel $2.");
109 $self->say($event, "$event->{'from'}: There is no tree called $tree is there?.");
111 } elsif ($message =~ /^\s*unmute tinderbox\s+(\S+?)\s+in\s+(\S+?)\s*$/osi) {
112 my $tree = $1 eq 'Tinderbox' ? '' : $1;
113 my $treeName = $tree eq '' ? 'all trees' : "trees named $tree";
114 if (($tree eq '') or (grep $_ eq $tree, @{$self->{'trees'}})) {
115 my %mutedChannels = map { lc($_) => 1 } split(/ /o, $self->{'mutes'}->{$1});
116 delete($mutedChannels{lc($2)}); # get rid of any mentions of that channel
117 $self->{'mutes'}->{$1} = join(' ', keys(%mutedChannels));
119 $self->say($event, "$event->{'from'}: Tinderbox notifications for trees named $1 resumed in channel $2.");
121 $self->say($event, "$event->{'from'}: There is no tree called $tree is there?.");
124 return $self->SUPER::Told(@_);
127 return $self->SUPER::Told(@_);
129 return 0; # dealt with it...
134 my ($event, $requested, @mode) = @_;
135 my @trees = @{$self->{'trees'}};
136 if ($self->{'isTinderbox2'}) {
138 my $uri = $self->{'tinderboxURI'} . $_ . "/quickparse.html";
139 $self->getURI($event, $uri, $requested, @mode);
142 local $" = ','; # XXX %-escape this
143 my $uri = $self->{'tinderboxURI'} . "showbuilds.cgi?quickparse=1&tree=@trees";
144 $self->getURI($event, $uri, $requested, @mode);
150 my ($event, $uri, $output, $requested, @mode) = @_;
152 my $now = $event->{'time'};
153 $self->{'_lastupdate'} = $now;
154 my @lines = split(/\n/os, $output);
156 # loop through quickparse output
157 foreach my $line (@lines) {
158 my ($type, $tree, $build, $state) = split(/\|/os, $line);
159 if ($type eq 'State') {
160 $self->{'treeStates'}->{$tree}->{'lastupdate'} = $now;
161 if (defined($self->{'treeStates'}->{$tree}->{'current'})) {
162 $self->{'treeStates'}->{$tree}->{'previous'} = $self->{'treeStates'}->{$tree}->{'current'};
164 $self->{'treeStates'}->{$tree}->{'current'} = $state;
165 $self->{'states'}->{$state} = $state unless defined($self->{'states'}->{$state});
166 } elsif ($type eq 'Build') {
167 $self->{'tinderboxStates'}->{$tree}->{$build}->{'lastupdate'} = $now;
168 if (defined($self->{'tinderboxStates'}->{$tree}->{$build}->{'current'})) {
169 $self->{'tinderboxStates'}->{$tree}->{$build}->{'previous'} = $self->{'tinderboxStates'}->{$tree}->{$build}->{'current'};
171 $self->{'tinderboxStates'}->{$tree}->{$build}->{'current'} = $state;
172 $self->{'states'}->{$state} = $state unless defined($self->{'states'}->{$state});
173 } # else unsupported type XXX
176 #If a Tinderbox tree is configured without Bonsai, it lacks a state line and doesn't
177 # appear properly in the trees output (even though machine state changes work.)
178 # Work around this by setting a default state of Unknown to trees w/o a state line.
179 my $state = "unknown";
180 foreach my $tree (keys(%{$self->{'tinderboxStates'}})) {
181 if (!defined($self->{'treeStates'}->{$tree})) {
182 $self->{'treeStates'}->{$tree}->{'current'} = $state;
183 $self->{'treeStates'}->{$tree}->{'lastupdate'} = $now;
184 if (defined($self->{'treeStates'}->{$tree}->{'current'})) {
185 $self->{'treeStates'}->{$tree}->{'previous'} = $self->{'treeStates'}->{$tree}->{'current'};
187 $self->{'states'}->{$state} = $state unless defined($self->{'states'}->{$state});
189 #Update timestamps on trees we're 'managing' state on.
190 if (($self->{'treeStates'}->{$tree}->{'current'} eq $state) and
191 ($self->{'treeStates'}->{$tree}->{'lastupdate'} < $now)) {
192 $self->{'treeStates'}->{$tree}->{'lastupdate'} = $now;
196 $self->CheckForUpdates($event, $requested);
197 if ($requested == 1) {
198 $self->ReportState($event, @mode);
199 } elsif ($requested == 2) {
200 $self->ReportBuild($event, @mode);
202 # update list of active trees
203 @{$self->{'lasttreesState'}} = @{$self->{'trees'}};
206 $self->say($event, "$event->{'from'}: I can't access tinderbox right now, sorry.");
208 $self->debug('failed to get tinderbox data');
215 my ($event, @data) = @_;
216 if ($data[0] eq 'tinderbox') {
217 $self->GetTrees($event, 0);
219 $self->SUPER::Scheduled($event, @data);
223 sub CheckForUpdates {
225 my ($event, $avoidTarget) = @_;
226 my $a; # disclaimer: I was asleep when I wrote the next line. I've no longer any idea what it does.
227 my @trees = map { $a = $_; grep { $_ eq $a } @{$self->{'lasttreesState'}}; } @{$self->{'treesAnnounced'}};
228 # After staring at it for a few minutes, I think what it does is get a list of the trees that should
229 # be announced, AND that have already been found to exist. But I'm not 100% sure.
230 foreach my $tree (@trees) {
238 if (defined($self->{'treeStates'}->{$tree})) {
239 if ($self->{'treeStates'}->{$tree}->{'lastupdate'} == $self->{'_lastupdate'}) {
240 if (defined($self->{'treeStates'}->{$tree}->{'previous'})) {
241 if ($self->{'treeStates'}->{$tree}->{'previous'} ne $self->{'treeStates'}->{$tree}->{'current'}) {
242 push(@changes, "$tree has changed state from $self->{'states'}->{$self->{'treeStates'}->{$tree}->{'previous'}} to $self->{'states'}->{$self->{'treeStates'}->{$tree}->{'current'}}.");
245 push(@newTrees, "New tree added to tinderbox: $tree (state: $self->{'states'}->{$self->{'treeStates'}->{$tree}->{'current'}}).");
248 # tree has dissappeared!
249 delete($self->{'treeStates'}->{$tree});
250 push(@lostTrees, "Eek!!! Tree '$tree' has been removed from tinderbox!");
252 } # else tree doesn't exist
255 if (defined($self->{'tinderboxStates'}->{$tree})) {
256 foreach my $build (keys(%{$self->{'tinderboxStates'}->{$tree}})) {
257 if ($self->{'tinderboxStates'}->{$tree}->{$build}->{'lastupdate'} == $self->{'_lastupdate'}) {
258 if (defined($self->{'tinderboxStates'}->{$tree}->{$build}->{'previous'})) {
259 if ($self->{'tinderboxStates'}->{$tree}->{$build}->{'previous'} ne $self->{'tinderboxStates'}->{$tree}->{$build}->{'current'}) {
260 push(@changes, "$tree: '$build' has changed state from $self->{'states'}->{$self->{'tinderboxStates'}->{$tree}->{$build}->{'previous'}} to $self->{'states'}->{$self->{'tinderboxStates'}->{$tree}->{$build}->{'current'}}.");
263 push(@newBuilds, "$tree: Build '$build' added to tinderbox. (Status: $self->{'states'}->{$self->{'tinderboxStates'}->{$tree}->{$build}->{'current'}}).");
266 # build has dissappeared!
267 delete($self->{'tinderboxStates'}->{$tree}->{$build});
268 push(@lostBuilds, "$tree: Build '$build' has dropped from tinderbox.");
271 } # else tree doesn't exist
273 # sort out which channels to talk to
274 my %mutedChannels = ();
275 if (defined($self->{'mutes'}->{$tree})) {
276 %mutedChannels = map { lc($_) => 1 } split(/\s+/os, $self->{'mutes'}->{$tree});
278 if (defined($self->{'mutes'}->{''})) {
279 %mutedChannels = (%mutedChannels, map { lc($_) => 1 } split(/\s+/os, $self->{'mutes'}->{''}));
281 if (($avoidTarget) and ($event->{'target'} eq $event->{'channel'})) {
282 $mutedChannels{$event->{'channel'}} = 1;
286 my @output = (@newTrees, @lostTrees, @newBuilds, @lostBuilds);
287 foreach (@{$self->{'channels'}}) {
288 unless ($mutedChannels{$_}) {
289 local $event->{'target'} = $_;
291 $self->sayOrNotice($event, $_);
293 if (@output < $self->{'maxInChannel'}) {
295 $self->sayOrNotice($event, $_);
298 $self->sayOrNotice($event, "Many tree changes just occured. Check tinderbox to see what they were.");
307 my ($event, $trees, $builds, $verbosity) = @_;
309 # $trees: 0=default; 1=all; 'x'=pattern match
310 # $builds: 0=all; 1=horked and test failed; 2=horked only
311 # $verbosity: 1=terse; 2; 3; 4=verbose
313 # the complete output
316 # work out which trees we want
319 @trees = @{$self->{'treesDefault'}};
320 } elsif ($trees eq '1') {
321 @trees = @{$self->{'trees'}};
323 my $pattern = $self->sanitizeRegexp($trees);
324 foreach my $tree (keys %{$self->{'treeStates'}}) {
325 push(@trees, $tree) if $tree =~ /$pattern/si;
331 foreach my $tree (@trees) {
332 if ((defined($self->{'treeStates'}->{$tree})) and ($self->{'treeStates'}->{$tree}->{'lastupdate'} == $self->{'_lastupdate'})) {
336 my ($redShort) = ($self->{'states'}->{'bustedShort'} or split(//osi, $self->{'states'}->{'busted'}));
338 my ($orangeShort) = ($self->{'states'}->{'testfailedShort'} or split(//osi, $self->{'states'}->{'testfailed'}));
340 my ($greenShort) = ($self->{'states'}->{'successShort'} or split(//osi, $self->{'states'}->{'success'}));
344 if (defined($self->{'tinderboxStates'}->{$tree})) {
345 foreach my $build (keys(%{$self->{'tinderboxStates'}->{$tree}})) {
346 if ($self->{'tinderboxStates'}->{$tree}->{$build}->{'lastupdate'} == $self->{'_lastupdate'}) {
348 my $state = $self->{'tinderboxStates'}->{$tree}->{$build}->{'current'};
351 if ($state eq 'success') {
353 } elsif ($state eq 'testfailed') {
359 # make sure we should list this build
360 if ($state eq 'success') {
361 next if $builds >= 1;
362 } elsif ($state eq 'testfailed') {
363 next if $builds >= 2;
366 if ($verbosity == 1) {
367 my($minibuild) = split(/\s/osi, $build);
368 my $ministate = $self->{'states'}->{$state.'Short'};
369 if (not $ministate) {
370 ($ministate) = split(//osi, $self->{'states'}->{$state});
372 push(@output, "$minibuild: $ministate;");
373 } elsif (($verbosity == 2) || ($verbosity == 3)) {
374 my($minibuild) = $verbosity == 2 ? split(/\s/osi, $build) : ($build);
375 my $ministate = $self->{'states'}->{$state.'Medium'};
376 if (not $ministate) {
377 $ministate = $self->{'states'}->{$state};
379 push(@output, "$minibuild ($ministate),");
381 push(@output, "[$build: $self->{'states'}->{$state}]")
384 } # else build is dead
386 } # else tree is dead
390 if ($verbosity == 1) {
392 unless ($red + $green + $orange) {
393 push(@output, "(none)");
394 } elsif ($builds <= 1) {
395 push(@output, "(all green)");
397 push(@output, "(none red)");
400 my $ministate = $self->{'states'}->{$self->{'treeStates'}->{$tree}->{'current'}.'Short'};
401 if (not $ministate) {
402 ($ministate) = split(//osi, $self->{'states'}->{$self->{'treeStates'}->{$tree}->{'current'}});
404 @newoutput = $self->wordWrap($self->{'preferredLineLength'},
405 "$tree <$ministate> $redShort:${red} $orangeShort:${orange} $greenShort:${green} ",
407 $newoutput[0] =~ s/^ //o;
408 $newoutput[$#newoutput] =~ s/;$//o;
409 push(@lines, @newoutput);
410 } elsif (($verbosity == 2) || ($verbosity == 3)) {
411 unless ($red+$orange+$green) {
412 push(@lines, "$tree <$self->{'states'}->{$self->{'treeStates'}->{$tree}->{'current'}}>: no tinderboxen for this tree.");
413 } elsif (($red) or ($orange)) {
415 # can only happen if $red is 0 and $builds is 1.
416 push(@output, "all tinderboxen compile");
418 my @newoutput = $self->wordWrap($self->{'preferredLineLength'},
419 "$tree <$self->{'states'}->{$self->{'treeStates'}->{$tree}->{'current'}}> $red red, $orange orange, $green green: ",
421 $newoutput[0] =~ s/^ //o;
422 $newoutput[$#newoutput] =~ s/,$//o;
423 # if (length(@newoutput[$#newoutput]) < $self->{'preferredLineLength'} - 33) {
424 # $newoutput[$#newoutput] .= " Summary: $red red, $orange orange, $green green";
426 # push(@newoutput, " Summary: $red red, $orange orange, $green green");
428 push(@lines, @newoutput);
430 push(@lines, "$tree <$self->{'states'}->{$self->{'treeStates'}->{$tree}->{'current'}}>: all $green tinderboxen green!");
434 unless ($red + $green + $orange) {
435 push(@output, "no tinderboxen for this tree.");
436 } elsif ($builds <= 1) {
437 push(@output, "all tinderboxen for this tree are green!");
439 push(@output, "all tinderboxen for this tree compile successfully.");
442 @newoutput = $self->wordWrap($self->{'preferredLineLength'},
443 "$tree <$self->{'states'}->{$self->{'treeStates'}->{$tree}->{'current'}}> $red red, $orange orange, $green green: ",
445 $newoutput[0] =~ s/^ //o;
446 push(@lines, @newoutput);
449 } # else tree is dead
453 } else { # no tree selected
454 @lines = ("No tree matches the pattern '$trees', sorry!");
457 $self->Report($event, 'tree status', @lines);
462 my ($event, $pattern) = @_;
464 # the complete output
467 foreach my $tree (@{$self->{'trees'}}) {
468 if ((defined($self->{'treeStates'}->{$tree})) and
469 ($self->{'treeStates'}->{$tree}->{'lastupdate'} == $self->{'_lastupdate'}) and
470 (defined($self->{'tinderboxStates'}->{$tree}))) {
471 foreach my $build (keys(%{$self->{'tinderboxStates'}->{$tree}})) {
472 if (($self->{'tinderboxStates'}->{$tree}->{$build}->{'lastupdate'} == $self->{'_lastupdate'}) and
473 ($build =~ /\Q$pattern\E/is)) {
474 push(@output, "[$build: $self->{'states'}->{$self->{'tinderboxStates'}->{$tree}->{$build}->{'current'}}]")
480 @output = ('There are no matching builds.') unless @output;
481 @output = $self->prettyPrint($self->{'preferredLineLength'}, undef, "$event->{'from'}: ", ' ', @output);
483 $self->Report($event, 'tree status', @output);
488 my ($event, $what, @output) = @_;
489 if (scalar(@output) > $self->{'maxInChannel'}) {
491 $self->directSay($event, $_);
493 $self->channelSay($event, "$event->{'from'}: $what /msg'ed");
496 $self->say($event, $_);
503 if ($self->{'useNotice'}) {