BotModules/FTP.bm

   1 ################################
   2 # FTP Module                   #
   3 ################################
   4
   5 package BotModules::FTP;
   6 use vars qw(@ISA);
   7 use Net::FTP;
   8 @ISA = qw(BotModules);
   9 1;
  10
  11 # RegisterConfig - Called when initialised, should call registerVariables
  12 sub RegisterConfig {
  13     my $self = shift;
  14     $self->SUPER::RegisterConfig(@_);
  15     $self->registerVariables(
  16       # [ name, save?, settable? ]
  17         ['host', 1, 1, 'ftp.mozilla.org'],
  18         ['path', 1, 1, '/pub/mozilla/nightly/latest'],
  19         ['updateDelay', 1, 1, 600],
  20         ['preferredLineLength', 1, 1, 80],
  21         ['data', 0, 0, {}],  # data -> file -> datetime stamp
  22         ['mutes', 1, 1, ''],  # "channel channel channel"
  23     );
  24 }
  25
  26 # Schedule - called when bot connects to a server, to install any schedulers
  27 # use $self->schedule($event, $delay, $times, $data)
  28 # where $times is 1 for a single event, -1 for recurring events,
  29 # and a +ve number for an event that occurs that many times.
  30 sub Schedule {
  31     my $self = shift;
  32     my ($event) = @_;
  33     $self->schedule($event, \$self->{'updateDelay'}, -1, 'ftp');
  34     $self->SUPER::Schedule($event);
  35 }
  36
  37 sub Help {
  38     my $self = shift;
  39     my ($event) = @_;
  40     my %commands = (
  41         '' => "This module monitors the FTP site 'ftp://$self->{'host'}$self->{'path'}/' and reports new files as they appear.",
  42         '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]\'',
  43     );
  44     if ($self->isAdmin($event)) {
  45         $commands{'mute'} = 'Disable reporting of new files in a channel. Syntax: mute ftp in <channel>';
  46         $commands{'unmute'} = 'Enable reporting of new files in a channel. Syntax: unmute ftp in <channel>';
  47     }
  48     return \%commands;
  49 }
  50
  51 sub Told {
  52     my $self = shift;
  53     my ($event, $message) = @_;
  54     if ($message =~ /^\s*ftp(?:\s+(\S+?))?\s*\?*\s*$/osi) {
  55         $self->spawnChild($event, \&ftp_check, [$self, $self->{'path'}, $self->{'host'}], 'ftp', [$event, $1]);
  56     } elsif ($self->isAdmin($event)) {
  57         if ($message =~ /^\s*mute\s+ftp\s+in\s+(\S+?)\s*$/osi) {
  58             $self->{'mutes'} .= " $1";
  59             $self->saveConfig();
  60             $self->say($event, "$event->{'from'}: Reporting of new files disabled in channel $1.");
  61         } elsif ($message =~ /^\s*unmute\s+ftp\s+in\s+(\S+)\s*$/osi) {
  62             my %mutedChannels = map { $_ => 1 } split(/ /o, $self->{'mutes'});
  63             delete($mutedChannels{$1}); # get rid of any mentions of that channel
  64             $self->{'mutes'} = join(' ', keys(%mutedChannels));
  65             $self->saveConfig();
  66             $self->say($event, "$event->{'from'}: Reporting of new files reenabled in channel $1.");
  67         } else {
  68             return $self->SUPER::Told(@_);
  69         }
  70     } else {
  71         return $self->SUPER::Told(@_);
  72     }
  73 }
  74
  75 sub Scheduled {
  76     my $self = shift;
  77     my ($event, @data) = @_;
  78     if ($data[0] eq 'ftp') {
  79         $self->spawnChild($event, \&ftp_check, [$self, $self->{'path'}, $self->{'host'}], 'ftp', [undef]);
  80     } else {
  81         $self->SUPER::Scheduled($event, @data);
  82     }
  83 }
  84
  85 # ChildCompleted - Called when a child process has quit
  86 sub ChildCompleted {
  87     my $self = shift;
  88     my ($event, $type, $output, @data) = @_;
  89     if ($type eq 'ftp') {
  90         my @output = split(/\n/os, $output);
  91         if (shift(@output)) {
  92             my @new = ();
  93             while (@output) {
  94                 my ($file, $stamp) = (shift(@output), shift(@output));
  95                 if ((defined($self->{'data'}->{$file})) and ($self->{'data'}->{$file} < $stamp)) {
  96                     push(@new, $file);
  97                 }
  98                 $self->{'data'}->{$file} = $stamp;
  99             }
 100             if ((defined($self->{'_ready'})) and (scalar(@new))) {
 101                 my $s = scalar(@new) > 1 ? 's' : '';
 102                 @output = $self->prettyPrint($self->{'preferredLineLength'},
 103                                              "New file$s in ftp://$self->{'host'}$self->{'path'}/ :  ",
 104                                              '', '  ', @new);
 105                 foreach my $channel (@{$self->{'channels'}}) {
 106                     unless ($self->{'mutes'} =~ /^(.*\s|)\Q$channel\E(|\s.*)$/si) {
 107                         $event->{'target'} = $channel;
 108                         foreach (@output) {
 109                             $self->say($event, $_);
 110                         }
 111                     }
 112                 }
 113             }
 114             $self->{'_ready'} = 1;
 115             if ($data[0]) {
 116                 $self->ftp_stamp($event, $data[1]);
 117             }
 118         } else {
 119             if ($data[0]) {
 120                 $self->say($event, "I could not contact $self->{'host'}, sorry.");
 121             }
 122             $self->tellAdmin($event, "Dude, I'm having a problem with FTP. Could you prod $self->{'host'} for me please? Or fix my config? Cheers.");
 123         }
 124     } else {
 125         $self->SUPER::ChildCompleted($event, $type, $output, @data);
 126     }
 127 }
 128
 129
 130
 131 # The following is directly from the original techbot (mozbot 1.5), written by timeless.
 132 # The only changes I made were to port it to the mozbot2 architecture. Those changes
 133 # are commented.
 134
 135 sub day_str {
 136         my (@stamp,$ahr,$amn,$asc);
 137         ($asc, $amn, $ahr, @stamp)=gmtime($_[3]);
 138         $asc = "0$asc" if $asc < 10; # \
 139         $amn = "0$amn" if $amn < 10; #  -- added these to zero-pad output
 140         $ahr = "0$ahr" if $ahr < 10; # /
 141         return "$_[4] ($ahr:$amn:$asc)  " # added extra space to neaten output
 142                 if ($stamp[0]==$_[0] && $stamp[1]==$_[1] && $stamp[2]==$_[2]);
 143 }
 144
 145 sub ftp_stamp {
 146
 147     # It seems that the original wanted ($to, $cmd, $rest) as the arguments.
 148     # However, it doesn't use $to except at the end (which we replace) and
 149     # it doesn't use $cmd at all. This is lucky for us, since the first
 150     # argument of methods is always the object ref.
 151     my $self = $_[0];
 152     # This function also expects to be able to use a global (!) variable
 153     # called %latestbuilds. We grandfather that by making a lexically scoped
 154     # copy of one of our object fields.
 155     my %latestbuilds = %{$self->{'data'}};
 156     # We have to keep a copy of $event around for when we send out the
 157     # output, of course. So let's use the second argument for that:
 158     my $event = $_[1];
 159     # Finally, we have to work around a serious bug in the original version,
 160     # which assumed any pattern input was valid regexp. [XXX use eval]
 161     $_[2] = defined($_[2]) ? quotemeta($_[2]) : 0;
 162     # In summary, call this function like this:
 163     # $self->ftp_stamp($event, $pattern);
 164
 165
 166         # various instances of time() below were changed to use $event->{'time'}
 167         # so that we are less prone to time drift
 168         my @day=gmtime($event->{'time'}); my @tm=@day[0..2]; @day=@day[3..5];
 169         my (@filestamp, $filelist, $ahr,$amn,$asc);
 170         if ($_[2]){  # this code's output is *VERY* ugly. But I just took it as is, so deal with it. Patches welcome.
 171                 foreach my $filename (keys %latestbuilds){
 172                         my @ltm=gmtime($latestbuilds{$filename});
 173                         $filelist.="$filename [".($ltm[5]+1900).'-'.($ltm[4]+1)."-$ltm[3] $ltm[2]:$ltm[1]:$ltm[0]]"
 174                                 if $filename=~/$_[2]/;
 175                 }
 176                 $filelist=$filelist||'<nothing matched>';
 177                 $filelist="Files matching re:$_[2] [gmt] $filelist";
 178         }else{
 179                 foreach my $filename (keys %latestbuilds){
 180                         $filelist.=day_str(@day[0..2],$latestbuilds{$filename},$filename);
 181                 }
 182                 if ($filelist){
 183                         $filelist="Files from today [gmt] $filelist";
 184                 } else {
 185                         foreach my $filename (keys %latestbuilds){
 186                               @day=gmtime($event->{'time'}-86400); @day=@day[3..5];
 187                                 $filelist.=day_str(@day[0..2],$latestbuilds{$filename},$filename);
 188                         }
 189                         $filelist="Files from yesterday [gmt] $filelist"|| # next line changed from " to \' and added missing '>'
 190                                 '<No files in the past two days by gmt, try \'ftp .\' for a complete filelist>';
 191                 }
 192         }
 193
 194
 195     # Append the current time for those not in GMT time zones
 196     my @time;
 197     foreach (@tm) {
 198         # zero pad the time
 199         $_ = "0$_" if $_ < 10;
 200         # switch digits around (@tm is in reverse order)
 201         unshift(@time, $_);
 202     }
 203     # output
 204     local $";
 205     $" = ':';
 206     $filelist .= " time now: @time";
 207     # Ok, now we want to send out the results (held in $filelist).
 208     $self->say($event, $filelist);
 209 }
 210
 211
 212 sub ftp_check {
 213
 214     # ok, this function has been hacked for the new architecture.
 215     # ftp_check is called in a spawned child.
 216     # It returns the output in a fixed format back to the parent
 217     # process. The format is
 218     #    1
 219     #    file
 220     #    timestamp
 221     #    file
 222     #    timestamp
 223     # if it fails, the '1' will be missing (no output).
 224     # It should be passed the following arguments:
 225     # [$self, $path, $server]
 226     my $self = $_[0];
 227     my $output = '';
 228
 229         my $buf='';
 230         my $mdtms;
 231         my $ftpserver=$_[2];
 232         my $ftp = new Net::FTP($ftpserver, Debug => 0, Passive => 1);
 233         if ($ftp){
 234                 $output .= "1\n"; # how we find out if it worked or not
 235                 if ($ftp->login('anonymous','mozbot@localhost')){
 236                         $ftp->cwd($_[1]); # path used to be hardcoded
 237                         for my $f ($ftp->ls){
 238                                 $mdtms=$ftp->mdtm($f);
 239                                 $output .= "$f\n$mdtms\n"; # output to pipe instead of irc
 240                         }
 241                         $ftp->quit;
 242                 };
 243         }
 244
 245     # now send out the buffered output
 246     return $output;
 247
 248 }