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