################################ # 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); # 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||''; $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 '>' ''; } } # 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; }